Nossa estou com uma dor de cabeça tentando resolver o envio de sms alguem pode dar uma luz ai ?
unit USMS;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, AdvSmoothPanel, AdvSmoothLabel, StdCtrls,
ShellApi, DB, MemDS, DBAccess, MyAccess, IniFiles, ACBrSMSDaruma, ACBrBase,
ACBrSMS, ACBrSMSClass, StrUtils, JvComponentBase, JvTrayIcon, Menus, ImgList,
System.ImageList, Vcl.ComCtrls, Vcl.Grids, Vcl.DBGrids;
type
TForm1 = class(TForm)
Timer1: TTimer;
Conexao: TMyConnection;
MySmsTemp: TMyQuery;
DSsmsTemp: TDataSource;
MyConfiguracoes: TMyQuery;
DSConfiguracoes: TDataSource;
MyConfiguracoesModeloSms: TStringField;
MyConfiguracoesPortaSms: TStringField;
MyConfiguracoesVelocidadeSms: TIntegerField;
MySmsTempTelefone: TStringField;
MySmsTempMensagem: TStringField;
ACBrSMS1: TACBrSMS;
MySmsTempstatus: TStringField;
MySmsTempID: TIntegerField;
timerInfos: TTimer;
PopupMenu1: TPopupMenu;
Fecharoaplicativo1: TMenuItem;
JvTrayIcon1: TJvTrayIcon;
ImageList1: TImageList;
rdgBandeja: TRadioGroup;
btnTrocarChip: TButton;
lb_listaEnviados: TListBox;
Panel1: TPanel;
ProgressBar1: TProgressBar;
lb_progresso: TLabel;
btnativar: TButton;
GroupBox1: TGroupBox;
lb_mensagemEnviar: TLabel;
lb_serverOnline: TLabel;
lb_sinal: TLabel;
lb_modeloModem: TLabel;
lb_operadora: TLabel;
DBGrid1: TDBGrid;
Panel2: TPanel;
Panel3: TPanel;
MyConfiguracoesSmsTimeOut: TIntegerField;
procedure Label4Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure timerInfosTimer(Sender: TObject);
procedure Fecharoaplicativo1Click(Sender: TObject);
procedure btnTrocarChipClick(Sender: TObject);
procedure ACBrSMS1Progresso(const AAtual, ATotal: Integer);
procedure btnativarClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
procedure EnviarSMS;
procedure ModeloSMS;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Modelo:Integer;
vStatus:String;
implementation
Const
C1 = 32827;
C2 = 94854;
{$R *.dfm}
function Descryptografar(const S: ShortString; Key: Word): String;
var
I: byte;
x: char;
begin
result := '';
i := 1;
while (i < Length(S)) do
begin
x := char(strToInt('$' + Copy(s, i, 2)));
Result := result + char(byte(x) xor (Key shr 8));
Key := (byte(x) + Key) * C1 + C2;
Inc(i, 2);
end;
end;
procedure TForm1.ACBrSMS1Progresso(const AAtual, ATotal: Integer);
begin
lb_progresso.Caption := Format('%d de %d', [AAtual, ATotal]);
ProgressBar1.Position := AAtual;
ProgressBar1.Max := ATotal;
Application.ProcessMessages;
end;
procedure TForm1.btnTrocarChipClick(Sender: TObject);
begin
if ACBrSMS1.BandejasSimCard < 2 then
raise Exception.Create('Este modelo possui somente uma bandeja de SimCard.');
if rdgBandeja.ItemIndex = 0 then
ACBrSMS1.TrocarBandeja(simCard1)
else
ACBrSMS1.TrocarBandeja(simCard2);
ShowMessage(
'Pronto.' +
sLineBreak +
sLineBreak +
'Última resposta:' + sLineBreak +
String(ACBrSMS1.UltimaResposta)
);
end;
procedure TForm1.btnativarClick(Sender: TObject);
begin
if not ACBrSMS1.Ativo then
begin
ACBrSMS1.Modelo := TACBrSMSModelo( Modelo );
ACBrSMS1.Device.Porta := MyConfiguracoesPortaSms.AsString;
ACBrSMS1.Device.Baud := MyConfiguracoesVelocidadeSms.AsInteger;
ACBrSMS1.ATTimeOut := MyConfiguracoesSmsTimeOut.AsInteger;
ACBrSMS1.Ativar;
btnAtivar.Caption := 'Desativar';
Timer1.Enabled:=True;
timerInfos.Enabled:=True;
vStatus := 'livre';
// menTrocarBandeja.Visible := ACBrSMS1.BandejasSimCard > 1;
end
else
begin
Timer1.Enabled:=False;
timerInfos.Enabled:=False;
ACBrSMS1.Desativar;
btnAtivar.Caption := 'Ativar';
end;
end;
procedure TForm1.EnviarSMS;
var
Indices: String;
LoteMsgs: TACBrSMSMensagens;
vQtdMsg : Integer;
begin
LoteMsgs := TACBrSMSMensagens.Create;
try
// envio de lote apartir de arquivo
// cada linha do arquivo é uma mensagem, seguinte o padrão:
// 1122223333|Mensagem que deseja enviar
//
// LoteMsgs.LoadFromFile(OpenDialog1.FileName);
{
Pode ser populada a mão utilizado o método Add, assim o usuário pode
montar a lista a partir de uma tabela no banco de dados por exemplo
Exemplo: }
vQtdMsg:=0;
Timer1.Enabled:=False;
Application.ProcessMessages;
MySmsTemp.First;
while not MySmsTemp.Eof do
begin
vStatus := 'enviando';
if Length(MySmsTempTelefone.AsString) > 7 then
begin
with LoteMsgs.Add do
begin
Telefone := MySmsTempTelefone.AsString;
Mensagem := MySmsTempMensagem.AsString;
vQtdMsg := vQtdMsg+1;
end;
end;
MySmsTemp.Delete;
Application.ProcessMessages;
end;
lb_mensagemEnviar.Caption := 'Mensagens a Enviar : '+IntToStr(vQtdMsg);
ACBrSMS1.EnviarSMSLote(LoteMsgs, Indices);
lb_listaEnviados.Items.Add('Lote de : ' + IntToStr(vQtdMsg) + ' mensagens enviadas - '+TimeToStr(Time));
Application.ProcessMessages;
finally
LoteMsgs.Free;
MySmsTemp.Refresh;
vStatus := 'livre';
Timer1.Enabled:=True;
ProgressBar1.Position:=0;
lb_progresso.Caption := 'Progresso de Envio';
Application.ProcessMessages;
end;
end;
procedure TForm1.Fecharoaplicativo1Click(Sender: TObject);
begin
Application.Terminate;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ACBrSMS1.Desativar;
end;
procedure TForm1.FormShow(Sender: TObject);
Var
Username, Password,Database,Server,Port : String;
ArqINI : TIniFile;
begin
try
// Conexão Com arquivo Conf.ini (Inicio)
ArqINI := TIniFile.Create(ExtractFilePath(Application.ExeName)+'Config.ini');
Username := Descryptografar(ArqINI.ReadString('UNICHEFF','Username',''),0);
Password := Descryptografar(ArqINI.ReadString('UNICHEFF','Password',''),0);
Database := Descryptografar(ArqINI.ReadString('UNICHEFF','Database',''),0);
Server := Descryptografar(ArqINI.ReadString('UNICHEFF','Server',''),0);
Port := Descryptografar(ArqINI.ReadString('UNICHEFF','Port',''),0);
// Fim
Conexao.Username := Username;
Conexao.Password := Password;
Conexao.Port := StrToInt(Port);
Conexao.Database := Database;
Conexao.Server := Server;
Conexao.Connected:= True;
MySmsTemp.Active:=True;
MyConfiguracoes.Active:=True;
except
ShowMessage('Erro na base de dados');
Application.Terminate;
end;
MySmsTemp.Close;
MySmsTemp.SQL.Clear;
MySmsTemp.SQL.Add('select * from sms_temp where status = 0 ');
MySmsTemp.Open;
ModeloSMS;
btnativar.Click;
end;
procedure TForm1.Label4Click(Sender: TObject);
begin
ShellExecute(Handle,'Open','http://www.unitechsistemas.com.br/','','',1);
end;
procedure TForm1.ModeloSMS;
begin
if MyConfiguracoesModeloSms.Asstring = 'modNenhum' then Modelo := 0;
if MyConfiguracoesModeloSms.Asstring = 'modDaruma' then Modelo := 1;
if MyConfiguracoesModeloSms.Asstring = 'modZTE' then Modelo := 2;
if MyConfiguracoesModeloSms.Asstring = 'modGenerico' then Modelo := 3;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
MySmsTemp.Refresh;
Application.ProcessMessages;
if not MySmsTemp.Eof then
begin
if vStatus = 'livre' then
EnviarSMS;
end;
end;
procedure TForm1.timerInfosTimer(Sender: TObject);
var
Msg: String;
begin
Msg := IfThen(ACBrSMS1.EmLinha, 'SMS em linha', 'SMS não está em linha.');
lb_serverOnline.Caption:=Msg;
lb_operadora.Caption:=ACBrSMS1.Operadora;
lb_sinal.Caption:='Sinal : '+FloatToStr(ACBrSMS1.NivelSinal);
lb_modeloModem.Caption:='Modelo do Modem : '+ACBrSMS1.ModeloModem;
end;
end.
esta ocorrendo o mesmo erro. CMS ERROR 500
tipo crio um lote de umas 2000 mensagens mais da esse erro , e ontem começou enviar mas parava no meio enviou umas 170 somente
