futamapas.pas

This delphi 7 source code have a function to send SMS trough computer with serial communication. You

unit FUtamapas;

interface

uses
  Forms, StrUtils, ClipBrd, Dialogs, SysUtils, Controls, Classes, DateUtils, Graphics,
  Buttons, ExtCtrls, StdCtrls, ComCtrls, Menus, XComDrv, Registry,
  jpeg, gsm_sms;

type
  TfUtama = class(TForm)
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    txtPesan: TMemo;
    Label3: TLabel;
    cbFlash: TCheckBox;
    cbReply: TCheckBox;
    cbReport: TCheckBox;
    txtNomor: TEdit;
    lblSisa: TLabel;
    XComm1: TXComm;
    cbFC: TComboBox;
    cbBaud: TComboBox;
    cbPort: TComboBox;
    SpeedButton3: TSpeedButton;
    Label5: TLabel;
    Label6: TLabel;
    Label12: TLabel;
    SpeedButton1: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure txtPesanChange(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure XComm1Data(Sender: TObject; const Received: Cardinal);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { Private declarations }
    procedure SetTerkoneksi;
    procedure getInfo(buffer: string);
    function GoKonek: Boolean;
  public
    { Public declarations }
    function KirimSMS(Tujuan, Isi: string): boolean;
    function SendGetData(Teks, Batas: String): String;
  end;

const
        sOK = #13#10'OK';
        sERROR = #13#10'ERROR';
        arPhoneInfo: array[1..10] of string[20] = ('battchg', 'signal', 'batterywarning',
                                                 'chargerconnected', 'service', 'sounder',                                                 'message', 'call', 'roam', 'callsetup');
var
  fUtama: TfUtama;
  SMSC: String;
  PBCache,
  Item,
  List: TStrings;
  fSMS,
  fPB: file;
  LastSortedColumn: integer;
  Ascending: boolean;
  Konek: Boolean;
  Buffer: WideString;
  ReadyState: Boolean;
  BatasStr: String;
  NamaLama,
  PBID: String;
  PhoneInfo : array[1..20] of string;
  JumlahPhoneInfo : Integer;

  SedangBaca : Boolean;

implementation

uses FReportpas,FAbautpas;

{$R *.dfm}

function TrimAll(t: string): string;
var s: string;
begin
        s := trim(t);
        s := copy(s, 2, length(s) - 2);
        result := s;
end;

function GetNextLongSMSRefference: string;
var
  mref: integer;
begin
  randomize;
  mref := 1 + random(252);
  with TRegistry.Create do
    try
          if (mref < 0) or (mref >= 255) then mref := 0;
          inc(mref);
          WriteInteger('MessageRef',mref);
    finally
    end;
  Result := IntToHex(mref, 2);
end;

function TfUtama.KirimSMS(Tujuan, Isi: string): boolean;
var
   PDU,
   udhi,
   smstotal,
   smsref,
   tempisi,
   s: string;
   sms: tSMS;
   i, p: integer;
begin
        if not konek then begin
                Result := false;
                exit;
        end;

        sms := TSMS.Create;
        sms.Number := tujuan;
        sms.RequestReply := cbReply.Checked;
        sms.FlashSMS := cbFlash.Checked;
        sms.StatusRequest := cbReport.Checked;
        sms.dcs := -1;
        Result := true;
        if length(isi) <= 160 then begin
                sms.Text := isi;
                sms.UDHI := '';
                pdu := sms.PDU;
                s := SendGetData('AT+CMGS=' + inttostr(sms.tplength) + #13, '>');
                s := SendGetData(PDU + #$1A, sOK);
                Result := pos(sOK, s) > 0;
        end
        else begin
                p := 153;
                smstotal := IntToHex((length(isi) div p) + 1, 2);
                smsRef := GetNextLongSMSRefference;
                udhi := '050003' + smsRef + smstotal;
                for i := 1 to StrToInt('$' + smstotal) do begin
                        tempisi := Copy(isi, 1, p);
                        Delete(isi, 1, p);
                        sms.Text := tempisi;
                        sms.UDHI := udhi + IntToHex(i, 2);
                        pdu := sms.PDU;
                        s := SendGetData('AT+CMGS=' + inttostr(sms.tplength) + #13, '>');
                        s := SendGetData(PDU + #$1A, sOK);
                        Result := pos(sOK, s) > 0;
                end;
        end;
        sms.Free;
end;

function TfUtama.SendGetData;
var
        waktu: TDateTime;
begin
        ReadyState := False;
        BatasStr := Batas;
        Buffer := '';
        waktu := now;
        XComm1.SendString(Teks);
        while (Not ReadyState) and (SecondsBetween(waktu, Now) < 10)
         do Application.ProcessMessages;
        Result := Buffer;
end;

function TfUtama.GoKonek;
begin
     Konek := false;
     If Not fUtama.XComm1.Opened then 
        fUtama.XComm1.OpenDevice;

     if XComm1.SendString('ATE1'#13) and (XComm1.WaitForString(['OK'], 2000) <> -1) then
        Konek := True;
     Result := Konek;
end;

procedure TfUtama.getInfo;
var
    c,
    s: string;
    p, n,
    i: integer;
    l: TListItem;
begin
     List.Text := buffer;
     s := List.Strings[1];

     if Pos('AT+CGMI', Buffer) > 0 then begin
        c := copy(Buffer, pos('AT+CGMI', Buffer) + 2, length(Buffer));
        Item.Text := c;
        l := FReport.LvPhone.Items.Add;
        l.Caption := 'Merk HP';
        l.SubItems.Add(Item.Strings[2]);
     end;
     if Pos('AT+GMM', Buffer) > 0 then begin
        c := copy(Buffer, pos('AT+GMM', Buffer) + 2, length(Buffer));
        Item.Text := c;
        l := FReport.LvPhone.Items.Add;
        l.Caption := 'Modem';
        l.SubItems.Add(Item.Strings[2]);
     end;
     if Pos('AT+CGSN', Buffer) > 0 then begin
        c := copy(Buffer, pos('AT+CGSN', Buffer) + 2, length(Buffer));
        Item.Text := c;
        l := FReport.LvPhone.Items.Add;
        l.Caption := 'I M E I';
        l.SubItems.Add(Item.Strings[2]);
     end;
     if Pos('+COPS:', Buffer) > 0 then begin
        c := copy(Buffer, pos('+COPS:', Buffer) + 7, length(Buffer));
        c := AnsiReplaceStr(c, ',', #13);
        Item.Text := c;
        l := FReport.LvPhone.Items.Add;
        l.Caption := 'Network Operator';
        l.SubItems.Add(TrimAll(Item.Strings[2]));
     end;
     if Pos('+CSCA:', Buffer) > 0 then begin
        c := copy(Buffer, pos('+CSCA:', Buffer) + 7, length(Buffer));
        c := AnsiReplaceStr(c, ',', #13);
        Item.Text := c;
        l := FReport.LvPhone.Items.Add;
        l.Caption := 'Service Center';
        SMSC := TrimAll(Item.Strings[0]);
        l.SubItems.Add(SMSC);
     end;
     if Pos('+CIND:', Buffer) > 0 then begin
        c := copy(Buffer, pos('+CIND:', Buffer) + 7, length(Buffer));
        i := 0;
        p := pos('("', c);
        while p > 0 do begin
                n := pos('",', c);
                s := copy(c, p + 2, n - p - 2);
                PhoneInfo[i] := s;
                Inc(i);
                Delete(c, p, n + 2);
                p := pos('("', c);
        end;
        JumlahPhoneInfo := i;
     end;
end;

procedure TfUtama.SetTerkoneksi;
begin
     If not Konek then
          Exit;
     FReport.LvPhone.Items.Clear;
     getInfo(SendGetData('AT+CGMI'#13, sOK));
     getInfo(SendGetData('AT+GMM'#13, sOK));
     getInfo(SendGetData('AT+CGSN'#13, sOK));
     getInfo(SendGetData('AT+COPS?'#13, sOK));
     getInfo(SendGetData('AT+CSCA?'#13, sOK));
     getInfo(SendGetData('AT+CIND=?'#13, sOK));
     SpeedButton3.Caption := 'Diskonek';
     cbPort.Enabled := False;
     cbBaud.Enabled := False;
     cbFC.Enabled := False;
     SedangBaca := False;
end;

procedure TfUtama.FormCreate(Sender: TObject);
var i : integer;
begin
     Item := TStringList.Create;
     List := TStringList.Create;
     PBCache := TStringList.Create;
     Konek := False;
     Buffer := '';

     cbPort.Items.Clear;
     for i := 1 to 30 do
        cbPort.Items.Add('COM' + IntToStr(i));
     cbPort.ItemIndex := 2;
     cbBaud.Items.Clear;
     cbBaud.Items.Add('9600');
     cbBaud.Items.Add('19200');
     cbBaud.Items.Add('57600');
     cbBaud.Items.Add('115200');
     cbBaud.Items.Add('128000');
     cbBaud.Items.Add('256000');
     cbBaud.ItemIndex := 1;
     cbFC.Clear;
     cbFC.Items.Add('None');
     cbFC.Items.Add('RTS-CTS');
     cbFC.Items.Add('DTR-DSR');
     cbFC.Items.Add('Software');
     cbFC.ItemIndex := 0;
     XComm1.BaudRate := brCustom;
     XComm1.FlowControl := fcNone;
     LastSortedColumn := -1;
     Ascending := True;
     PBID := '';
end;

procedure TfUtama.FormClose(Sender: TObject; var Action: TCloseAction);
begin
     if XComm1.Opened then
        while XComm1.Opened do XComm1.CloseDevice;
     List.Free;
     Item.Free;
     PBCache.Free;
end;


      
procedure TfUtama.txtPesanChange(Sender: TObject);
var p, s : integer;
begin
        p := ((length(txtPesan.Text) - 1) div 160) + 1;
        s := length(txtPesan.Text) mod 160;
        if (s = 0) and (length(txtPesan.Text) <> 0) then s := 160;
        lblSisa.Caption := IntToStr(160 - s) + ' <' + IntToStr(p) + ' sms>';
end;

procedure TfUtama.SpeedButton3Click(Sender: TObject);
begin
    if Konek then begin
        XComm1.CloseDevice;
        SpeedButton3.Caption := 'Konek';
        Konek := False;
        cbPort.Enabled := True;
        cbBaud.Enabled := True;
        cbFC.Enabled := True;
    end
    else begin
        XComm1.BaudValue := StrToInt(cbBaud.Text);
        XComm1.DeviceName := cbPort.Text;
        XComm1.FlowControl := TFlowcontrol(cbFC.ItemIndex);
        If Not GoKonek Then
                ShowMessage('Gagal membuka port')
        else
                SetTerkoneksi;
    end;
end;

procedure TfUtama.SpeedButton4Click(Sender: TObject);
begin
        fAbout.ShowModal;
end;

procedure TfUtama.SpeedButton5Click(Sender: TObject);
begin
        Close;
end;

procedure TfUtama.SpeedButton6Click(Sender: TObject);
begin
        if not Konek then begin
                ShowMessage('Belum terkoneksi ke HP');
                exit;
        end;
end;

procedure TfUtama.SpeedButton7Click(Sender: TObject);
var c : string;
    i : integer;
begin
        if txtNomor.Text = '' then begin
                ShowMessage('Nomor harus diisikan');
                exit;
        end;
        if not Konek then begin
                ShowMessage('Belum terkoneksi ke HP');
                exit;
        end;
        c := AnsiReplaceStr(txtNomor.Text, ',', #13#10);
        Item.Text := c;
        for i := 0 to Item.Count - 1 do begin
           c := trim(Item.Strings[i]);
           if (KirimSMS(c, txtPesan.Text)) then
           begin
                ShowMessage('Pesan sukses dikirim ke ' + c);
           end
           else
                ShowMessage('Pesan gagal dikirim ke ' + c);
        end;
end;


procedure TfUtama.SpeedButton8Click(Sender: TObject);
begin
        txtNomor.Text := '';
        txtPesan.Text := '';
end;
procedure TfUtama.XComm1Data(Sender: TObject; const Received: Cardinal);
var data : string;
begin
        XComm1.ReadString(data);
        Buffer := Buffer + data;
        If (Not ReadyState) And (Pos(BatasStr, Buffer) > 0) Then Begin
                ReadyState := True;
        End;
end;

procedure TfUtama.SpeedButton1Click(Sender: TObject);
begin
FReport.ShowModal;
end;

end.