⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 umain.pas

📁 4. sms engine 1 + gammu
💻 PAS
字号:
unit Umain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls,ShellApi, Menus, DB, ADODB,Gammu;
const
 WM_CAllBack = WM_USER;

type
  TFmain = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    StatusBar1: TStatusBar;
    Timer1: TTimer;
    PopupMenu1: TPopupMenu;
    Connection1: TMenuItem;
    Service1: TMenuItem;
    Start1: TMenuItem;
    Stop1: TMenuItem;
    N1: TMenuItem;
    erminatApplication1: TMenuItem;
    PageControl1: TPageControl;
    TabSheet2: TTabSheet;
    GroupBox2: TGroupBox;
    ADOConnection: TADOConnection;
    GroupBox4: TGroupBox;
    Label14: TLabel;
    Label15: TLabel;
    LbModel: TLabel;
    LbFirmWare: TLabel;
    Label21: TLabel;
    Label22: TLabel;
    LbNewCode: TLabel;
    LbNetworkName: TLabel;
    Label16: TLabel;
    LbImei: TLabel;
    Label1: TLabel;
    DeviceComboBox: TComboBox;
    ADOQueryFree: TADOQuery;
    TimerCekOutbox: TTimer;
    ADOQueryFree2: TADOQuery;
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure erminatApplication1Click(Sender: TObject);
    procedure Connection1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Start1Click(Sender: TObject);
    procedure Stop1Click(Sender: TObject);
    procedure TimerCekOutboxTimer(Sender: TObject);
  private
    { Private declarations }
    { Private declarations }
    PhoneID                        : integer;
    SendSMS                        : GSM_SMSMessage;
    PhoneCallBackPointer           : PPhoneCallBackProc;
    SecurityCallBackPointer        : PSecurityCallBackProc;
    SMSCallBackPointer             : PSMSCallBackProc;
    TrayIcon                       : TNotifyIconData;
    procedure ShowPopupMenu;
  public
    { Public declarations }
    procedure GetAllInboxSMS();
  end;
Type
  Void = Type Pointer;
  
var
  Fmain: TFmain;
  id_outG,tujuanG,isiG,pathLoc:string;
  ThreadSMSID , ThreadSMSHandle  : Cardinal;
  ThreadCon, ThreadConHandle : Cardinal;
  ThreadDis, ThreadDicHandle : Cardinal;
  ThreadNetwork, ThreadNetworkHandle : Cardinal;
  ThreadInfoDev, ThreadInfoDevHandle : Cardinal;

implementation

{$R *.dfm}

procedure ThreadGetInfoDev;safecall;
var
        buffer : array[1..100] of char;
        error  : GSM_Error;
        ver    : Double;
begin
 with Fmain do
 begin
  error:=GSM_GetIMEI(PhoneID,@buffer);
  if (error = ERR_NONE)then
      LbImei.Caption:=buffer;


  error:=GSM_GetModel(PhoneID,@buffer);
  if (error = ERR_NONE) then
      LbModel.Caption:=buffer;

  error:=GSM_GetFirmwareVersion(PhoneID,@ver);
  if (error = ERR_NONE) then
     LbFirmWare.Caption:=floattostr(ver);
  end;
   TerminateThread(ThreadInfoDevHandle,0);
end;

procedure ThreadGetInfo;safecall;
var
        NetInfo : GSM_NetworkInfo;
        error   : GSM_Error;
begin
 with  Fmain do
  begin
        error:=GSM_GetNetworkInfo(PhoneID,@NetInfo);
        if (error = ERR_NONE) then
        begin
                if ((NetInfo.State = GSM_HomeNetwork)or(NetInfo.State = GSM_RoamingNetwork)) then
                    LbNewCode.Caption:=NetInfo.NetworkCode;
                GSM_GetNetworkName(@NetInfo.NetworkCode,@NetInfo.NetworkName);
                LbNetworkName.Caption:=GetGammuUnicodeString(NetInfo.NetworkName);
        end
        else
            ShowMessage('Error '+inttostr(integer(error)));
   end;
end;

procedure getInfo;
begin
  ThreadInfoDevHandle:=CreateThread(nil, 1024, @ThreadGetInfoDev ,nil,0,ThreadInfoDev);
end;

Procedure ThreadSMSSend;SafeCall;
var
  i           : word;
  error       : GSM_Error;
  wktu        : string;
begin
    wktu:=FormatDateTime('yyyy/mm/dd hh:nn:ss',Now);
    i:=0;
    while i<strlen(PChar(tujuanG)) do
     begin
        Fmain.SendSMS.Number[i*2+1]:=tujuanG[i+1];
        Fmain.SendSMS.Number[i*2+2]:=chr(0);
        i:=i+1;
     end;
    Fmain.SendSMS.Number[i*2+1]:=chr(0);
    Fmain.SendSMS.Number[i*2+2]:=chr(0);


    Fmain.SendSMS.Length:=strlen(PChar(isig));
    i:=0;
    while i<strlen(PChar(isig)) do
     begin
        Fmain.SendSMS.Text[i*2+1]:=isig[i+1];
        Fmain.SendSMS.Text[i*2+2]:=chr(0);
        i:=i+1;
     end;
    Fmain.SendSMS.Text[i*2+1]:=chr(0);
    Fmain.SendSMS.Text[i*2+2]:=chr(0);
    Fmain.SendSMS.Coding:=GSM_Coding_Default;
    Fmain.SendSMS.UDH.UDHType:=UDH_NoUDH;

    Fmain.SendSMS.SMSC.Location:=1;
    Fmain.SendSMS.ReplyViaSameSMSC:=false;
    Fmain.SendSMS.PDU:=SMS_Status_Report;

    Fmain.SendSMS.SMSClass:=-1;
    Fmain.SendSMS.RejectDuplicates:=false;
    Fmain.SendSMS.MessageReference:=chr(0);
    Fmain.SendSMS.ReplaceMessage:=chr(0);

    error:=GSM_SendSMSMessage(Fmain.PhoneID,@Fmain.SendSMS,30);

    if(error<>ERR_NONE)then
     begin
      with Fmain.ADOQueryFree do
      begin
         Close;
         SQL.Text:='INSERT INTO sent_items(telp_dest,message,date_time,status) VALUES('+''''+tujuanG+''''+','+''''+isiG+''''+','+''''+wktu+''''+','+''''+'Sent Failed'+''''+')';
         ExecSQL;
      end;
      ThreadSMSHandle:=CreateThread(nil, 1024, @ThreadSMSSend,nil,0,ThreadSMSID);
     end
    else
    begin
     with Fmain.ADOQueryFree do
       begin
         Close;
         SQL.Text:='INSERT INTO sent_items(telp_dest,message,date_time,status) VALUES('+''''+tujuanG+''''+','+''''+isiG+''''+','+''''+wktu+''''+','+''''+'Sent OK'+''''+')';
         ExecSQL;
         Close;
         SQL.Text:='DELETE FROM outbox WHERE outbox_id='+id_outG;
         ExecSQL;
       end;
       Fmain.TimerCekOutbox.Enabled:=true;
     end;
end;


procedure TFmain.GetAllInboxSMS;
var
        error       : GSM_Error;
        sms         : GSM_MultiSMSMessage;
        nmr,isi,tgl : string;
        start       : Boolean;
begin
        error := ERR_NONE;
        start:=true;
        while error = ERR_NONE do
        begin
         sms.SMS[1].Folder := 0;
         error := GSM_GetNextSMSMessage(Fmain.PhoneID,@sms,start);
         if (error = ERR_NONE) then
          begin
            if (sms.SMS[1].InboxFolder) then
              begin
               nmr:=GetGammuUnicodeString(sms.SMS[1].Number);
               isi:=StringReplace(GetGammuUnicodeString(sms.SMS[1].Text),'''','"',[rfReplaceAll, rfIgnoreCase]);
               tgl:=FormatDateTime('yyyy/mm/dd hh:nn:ss',Now);
               with ADOQueryFree2 do
                 begin
                   Close;
                   SQL.Text:='INSERT INTO inbox_ values('+''''+''''+','+''''+nmr+''''+','+''''+isi+''''+','+''''+tgl+''''+')';
                   ExecSQL;
                 end;
               sms.SMS[1].Folder:=0;
               GSM_DeleteSMSMessage(Fmain.PhoneID,@sms.SMS[1]);
              end;
          end;
          start:=false;
        end;
end;

procedure ChangePhoneState1(x:integer;ID:integer;status:boolean);stdcall;
begin
   Fmain.StatusBar1.Panels.Items[0].Text:='Not connected';
   if (status=True) then
   begin
        Fmain.StatusBar1.Panels.Items[0].Text:='Connected';
        ThreadInfoDevHandle:=CreateThread(nil, 1024, @ThreadGetInfoDev ,nil,0,ThreadInfoDev);
   end;
end;

procedure ChangeSecurityState(x:integer;ID:integer;SecurityState:GSM_SecurityCodeType);stdcall;
begin
   case SecurityState of
        SEC_SecurityCode:Fmain.StatusBar1.Panels.Items[1].Text:='Security code';
        SEC_Pin         :Fmain.StatusBar1.Panels.Items[1].Text:='PIN';
        SEC_Pin2        :Fmain.StatusBar1.Panels.Items[1].Text:='PIN2';
        SEC_Puk         :Fmain.StatusBar1.Panels.Items[1].Text:='PUK';
        SEC_Puk2        :Fmain.StatusBar1.Panels.Items[1].Text:='PUK2';
        SEC_None        :Fmain.StatusBar1.Panels.Items[1].Text:='';
   end;
end;

procedure HandleIncomingSMS(x:integer;ID:integer);stdcall;
begin
   Fmain.GetAllInboxSMS();
end;


procedure ThreadConnection;safecall ;
var
   Device: PChar;
   Connection: PChar;
   error: GSM_Error;
begin
 with Fmain do
 begin
   GetMem(Device,Length(DeviceComboBox.Text)+1);
   StrCopy(Device, PChar(DeviceComboBox.Text));
   GetMem(Connection,50);
   Connection[0] := chr(0);
   PhoneCallBackPointer    := @ChangePhoneState1;
   SecurityCallBackPointer := @ChangeSecurityState;
   SMSCallBackPointer      := @HandleIncomingSMS;
   error:=GSM_StartConnection(@PhoneID,Device,Connection,'','logfile','text',false,@PhoneCallBackPointer,@SecurityCallBackPointer,@SMSCallBackPointer);
   if (error=ERR_NONE) then
   begin
     StatusBar1.Panels.Items[0].Text:='Connnected';
     Button1.Enabled:=false;
     DeviceComboBox.Enabled:=False;
     Button2.Enabled:=True;
     Start1.Enabled:=false;
     Stop1.Enabled:=true;
     ThreadInfoDevHandle:=CreateThread(nil, 1024, @ThreadGetInfoDev ,nil,0,ThreadInfoDev);
     ThreadNetworkHandle:=CreateThread(nil, 1024, @ThreadGetInfo ,nil,0,ThreadNetwork);
     TimerCekOutbox.Enabled:=true;
   end
   else
      application.MessageBox(pchar('GSM device not found, error '+inttostr(integer(error))),'',0);
   FreeMem(Device);
   FreeMem(Connection);
 end;
 TerminateThread(ThreadConHandle,0);
end;

procedure TFmain.ShowPopupMenu; // Menampilkan popup menu
var
  CurPos: TPoint;
begin
  SetForegroundWindow(Self.Handle);
  GetCursorPos(CurPos);
  PopupMenu1.Popup(CurPos.x, CurPos.y);
  PostMessage(Self.Handle, WM_NULL, 0, 0);
end;

procedure ShowTaskbarIcon(const Show: boolean);
begin
  ShowWindow(Application.Handle, SW_HIDE);

  if Show = false then
    SetWindowLong(Application.Handle, GWL_EXSTYLE,
          GetWindowLong(Application.Handle,
          GWL_EXSTYLE) or WS_EX_TOOLWINDOW)

  else
    SetWindowLong(Application.Handle, GWL_EXSTYLE,
                WS_OVERLAPPED);

  ShowWindow(Application.Handle, SW_SHOW);
end;

procedure TFmain.FormCreate(Sender: TObject);
begin
TimerCekOutbox.Enabled:=false;
ADOConnection.Connected:=false;
 try
  ADOConnection.Connected:=true;
  //munculkan try icon
  TrayIcon.cbSize := SizeOf(TrayIcon);
  TrayIcon.Wnd := Self.Handle;
  TrayIcon.uID := 0;
  TrayIcon.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
  TrayIcon.uCallbackMessage := WM_MOUSEMOVE;
  TrayIcon.hIcon := Application.Icon.Handle;
  TrayIcon.szTip := 'Klik kanan untuk menampilkan menu';
  Shell_NotifyIcon(NIM_ADD, @TrayIcon);
  //---------------------
  ShowTaskbarIcon(false);
 except
  MessageDlg('application cannot run ! check your database and ODBC connection',mtError,[mbOK],0);
  Application.Terminate;
 end;
 Fmain.StatusBar1.Panels.Items[0].Text:='Not connected';
 StatusBar1.Panels.Items[1].Text:='00:00:00';
end;

procedure TFmain.Button3Click(Sender: TObject);
begin
 Hide;
end;

procedure TFmain.Timer1Timer(Sender: TObject);
begin
 StatusBar1.Panels.Items[1].Text:=TimeToStr(now);
end;

procedure TFmain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Shell_NotifyIcon(NIM_DELETE, @TrayIcon);
end;

procedure TFmain.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if X = 517 then
    ShowPopupMenu;
end;

procedure TFmain.erminatApplication1Click(Sender: TObject);
begin
 Application.Terminate;
end;

procedure TFmain.Connection1Click(Sender: TObject);
begin
 Show;
end;

procedure TFmain.Button1Click(Sender: TObject);
begin
try
  ThreadConHandle:=CreateThread(nil, 1024, @ThreadConnection ,nil,0,ThreadCon);
except
end;
end;

procedure ThreadConnectionFalse;safecall ;
var
 error: GSM_Error;
begin
 with Fmain do
 begin
   error:=GSM_EndConnection(PhoneID);
   if (error=ERR_NONE) then
   begin
           Button1.Enabled:=True;
           DeviceComboBox.Enabled:=True;
           Button2.Enabled:=False;
           StatusBar1.Panels.Items[0].Text:='Disconnect';
           LbModel.Caption:='None';
           LbFirmWare.Caption:='None';
           LbNewCode.Caption:='None';
           LbNetworkName.Caption:='None';
           LbImei.Caption:='None';
           Start1.Enabled:=true;
           Stop1.Enabled:=false;
           TimerCekOutbox.Enabled:=false;
           TerminateThread(ThreadSMSHandle,0);
   end
   else
      application.MessageBox(pchar('GSM device not found, error '+inttostr(integer(error))),'',0);
 end;
 TerminateThread(ThreadDicHandle,0);
end;

procedure TFmain.Button2Click(Sender: TObject);
begin
try
 Timer1.Enabled:=false;
 TimerCekOutbox.Enabled:=false;
finally
 ThreadDicHandle :=CreateThread(nil, 1024, @ThreadConnectionFalse ,nil,0,ThreadDis);
end;
end;

procedure TFmain.Start1Click(Sender: TObject);
begin
 Button1Click(Self);
end;

procedure TFmain.Stop1Click(Sender: TObject);
begin
 Button2Click(Self);
end;

procedure TFmain.TimerCekOutboxTimer(Sender: TObject);
begin
try
 with ADOQueryFree do
  begin
    Close;
    SQL.Text:='SELECT * FROM outbox ORDER BY outbox_id ASC LIMIT 0,1';
    Open;
    if not IsEmpty then
    begin
      tujuanG:=FieldValues['telp_number'];
      isiG   :=FieldValues['message'];
      id_outG:=FieldValues['outbox_id'];
      ThreadSMSHandle:=CreateThread(nil, 1024, @ThreadSMSSend,nil,0,ThreadSMSID);
      TimerCekOutbox.Enabled:=false;
    end;
  end;
except
end;  
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -