unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TfrmMain = class(TForm)
    Button1: TButton;
    Edit2: TEdit;
    Edit3: TEdit;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    Function GetPDUData(SMSC,DATel,SDU:String;var len:String):String;
    function PDUSMSC(Tel:String;var TelLen:Byte):String;
    Function PDUTel(Tel:String;var TelLen:Byte):String;
    Function PDUFmtStr(Val:string):string;
    procedure opencomm;
    Function readcom:string;
    Function sendmessage(var smsc,smsbody,telno:string):boolean;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;
  Data:string; 
  hcomm:thandle;

implementation

{$R *.dfm}
procedure tfrmMain.opencomm;
var  cc:tcommconfig;
     temp:string;
begin
     temp:='COM1';
     hcomm:=createfile(pchar(temp),generic_read or generic_write,0,nil,open_existing,0,0);
     if (hcomm=invalid_handle_value) then
        begin
             messagebox(0,'打開通信端口失敗！！','',mb_ok);
             exit;
        end;

     getcommstate(hcomm,cc.dcb);
     cc.dcb.BaudRate:=cbr_9600;
     cc.dcb.ByteSize:=8;
     cc.dcb.Parity:=noparity;
     cc.dcb.StopBits:=onestopbit;

     if not setcommstate(hcomm,cc.dcb) then
       begin
            messagebox(0,'通訊端口設置錯誤！！','',mb_ok);
            closehandle(hcomm);
            exit;
       end;
end;

Function TfrmMain.GetPDUData(SMSC,DATel,SDU:String;var len:String):String;
var
    i:Byte;
    Data:String;
    SMSC_Len,DATel_Len:Byte;
begin
      SMSC:=PDUSMSC(SMSC,SMSC_Len);
      DATel:=PDUTel('86'+DATel,DATel_Len);
      SDU:=PDUFmtStr(SDU);
      i:=Length(SDU) div 2;
      Data:='';
      Data:=Data+'3100';
      Data:=Data+DATel;
      Data:=Data+'00';
      Data:=Data+'08';
      Data:=Data+'A7';
      Data:=Data+IntToHex(i,2);
      Data:=Data+SDU;
      len:=IntToStr(2+DATel_Len+4+i);
      Result:=SMSC+Data;
end;

function TfrmMain.PDUSMSC(Tel:String;var TelLen:Byte):String;
var
    i,j:integer;
    str:string;
    s1,s2:String;
begin
    try
        str:='';
        TelLen:= Length(Tel);
        if (Length(Tel) div 2)<>0 then
              Tel:=Tel+'F';
        j:=Length(Tel) div 2;
        for i:=0 to j-1 do
          begin
                s1:=Tel[2];
                s2:=Tel[1];
                delete(Tel,1,2);
                str:=str+s1+s2;
          end;
        j:=Length(Str) div 2+1;
        str:=inttohex(j,2)+'91'+str;
        TelLen:=j+1;
        Result:=str;
    except
        result:='';
    end;
end;

Function TfrmMain.PDUTel(Tel:String;var TelLen:Byte):String;
var
    i,j:integer;
    str:string;
    s1,s2:String;
begin
     try
          str:='';
          TelLen:= Length(Tel);
          if (Length(Tel) div 2)<>0 then
             Tel:=Tel+'F';
          j:=Length(Tel) div 2;
          for i:=0 to j-1 do
              begin
                  s1:=Tel[2];
                  s2:=Tel[1];
                  delete(Tel,1,2);
                  str:=str+s1+s2;
              end;
          str:=inttohex(TelLen,2)+'91'+str;
          TelLen:=j+2;
          Result:=str;
      except
          result:='';
      end;
end;

Function TfrmMain.PDUFmtStr(Val:string):string;
var
    i,j,len:Integer;
    cur:Integer;
    t:String;
    ws:WideString;
begin
      Result:='';
      ws := Val;
      len := Length(ws);
      i := 1;
      j := 0;
      while i <= len do
      begin
          cur := ord(ws[i]);
          FmtStr(t,'%4.4X',[cur]);
          Result := Result+t;
          inc(i);
          j := (j+1) mod 7;
      end;
end;


Function TfrmMain.sendmessage(var smsc,smsbody,telno:string):boolean;
var
   temp,len,ret:string;
   lrc:longword;
begin
      Data:=GetPDUData(SMSC,telno,smsbody,Len);
      temp:='AT+CSMS=1'+#13;
      writefile(hcomm,pchar(temp)^,length(temp),lrc,nil);
      sleep(100);
      memo1.Text:='';
      memo1.Text:=readcom;
      frmMain.Refresh;

      temp:='AT+CNMI=2,2,0,1,1'+#13;
      writefile(hcomm,pchar(temp)^,length(temp),lrc,nil);
      sleep(100);
      memo1.Text:=memo1.Text+readcom;
      frmMain.Refresh;

      temp:='AT+CMGF=0'+#13;
      writefile(hcomm,pchar(temp)^,length(temp),lrc,nil);
      sleep(100);
      memo1.Text:=memo1.Text+readcom;
      frmMain.Refresh;

      temp:='AT+CMGS='+Len+#13;
      writefile(hcomm,pchar(temp)^,length(temp),lrc,nil);
      sleep(100);
      memo1.Text:=memo1.Text+readcom;
      frmMain.Refresh;

      temp:=Data+#26;
      writefile(hcomm,pchar(temp)^,length(temp),lrc,nil);
      sleep(200);
      memo1.Text:=memo1.Text+readcom;
      frmMain.Refresh;

      {Result:=false;
      ret:=readcom;
      Edit1.Text:=Edit1.Text+ret;
      frmMain.Refresh;
      if (pos('ERROR',ret)=0)
       then Result:=true;  }

      
      sleep(10000);
      memo1.Text:=memo1.Text+readcom;
      frmMain.Refresh;
end;


Function TfrmMain.readcom:string;
var temp:string;
    inbuff:array[0..10240] of char;
    nbytesread,dwerror:longword;
    cs:tcomstat;
begin
     clearcommerror(hcomm,dwerror,@cs);
     if  cs.cbInQue>sizeof(inbuff) then
     begin
          purgecomm(hcomm,purge_rxclear);
          exit;
     end;
     readfile(hcomm,inbuff,cs.cbInQue,nbytesread,nil);
     temp:=copy(inbuff,1,cs.cbInQue);
     result:=temp;
end;

procedure TfrmMain.Button1Click(Sender: TObject);
var
   smsc,tel,str:string;
begin
      smsc:='8613800535500';
      tel:=trim(edit2.Text);
      str:=trim(edit3.Text);

      if (sendmessage(smsc,str,tel)=true)
      then
       if (Application.Messagebox('短信息發送成功！',
          '系統提示',MB_OK+MB_DEFBUTTON1+MB_ICONQUESTION)=IDok)
       then abort;

end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
     opencomm;

end;

end.