xisms.~pas

手机短信发送源码

unit XiSms;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, SPComm,registry, ExtCtrls, Menus, ExtDlgs, StdCtrls, ComCtrls,
  Buttons, DB, ADODB, Grids, DBGrids;

type
  TMainForm = class(TForm)
    StatusBar1: TStatusBar;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Panel2: TPanel;
    Label22: TLabel;
    Image1: TImage;
    Panel1: TPanel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label15: TLabel;
    Label19: TLabel;
    ButtonLink: TButton;
    Editmanufacturer: TEdit;
    EditPhoneMark: TEdit;
    EditSoftVersion: TEdit;
    EditIMEI: TEdit;
    Editcapacity: TEdit;
    EditSignelintension: TEdit;
    EditSim: TEdit;
    EditPhoneNumber: TEdit;
    EditSmsCentrol: TEdit;
    EditSmscapacity: TEdit;
    ComboBoxPort: TComboBox;
    Buttondisconnect: TButton;
    EditNetwork: TEdit;
    ComboBoxBaud: TComboBox;
    ButtonRefresh: TButton;
    ButtonSend: TButton;
    TabSheet2: TTabSheet;
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    ADOConnection1: TADOConnection;
    ADOQuery1: TADOQuery;
    EditClientName: TEdit;
    RadioClientName: TRadioButton;
    RadioProductName: TRadioButton;
    EditProductName: TEdit;
    ButtonQuery: TButton;
    RadioProductID: TRadioButton;
    EditProductID: TEdit;
    Panel3: TPanel;
    Label1: TLabel;
    AddClientName: TEdit;
    Label13: TLabel;
    AddProductName: TEdit;
    Label14: TLabel;
    AddProductID: TEdit;
    Label16: TLabel;
    AddBuyDate: TEdit;
    ButtonAdd: TButton;
    Buttondel: TButton;
    ButtonCancel: TButton;
    ButtonModify: TButton;
    Button1: TButton;
    TabSheet3: TTabSheet;
    Label17: TLabel;
    EnterpriseNameEdit: TEdit;
    Label18: TLabel;
    EnterpriseTelEdit: TEdit;
    Label20: TLabel;
    ReturnResultCheckBox: TCheckBox;
    Label21: TLabel;
    LocalDatabasePath: TEdit;
    ModifyLocalSetButton: TButton;
    Label23: TLabel;
    EnterPriseNameAddDB: TEdit;
    Label24: TLabel;
    EnterPriseTelAddDB: TEdit;
    RadioButtonAdd: TRadioButton;
    RadioButtonModify: TRadioButton;
    TabSheet4: TTabSheet;
    DBGrid2: TDBGrid;
    Panel4: TPanel;
    ADOQuery2: TADOQuery;
    DataSource2: TDataSource;
    RadioButtonQuery: TRadioButton;
    RadioButtonQueryError: TRadioButton;
    ButtonResultQuery: TButton;
    ButtonReport: TButton;
    EnterpriseRadioButton: TRadioButton;
    EnterpriseQueryEdit1: TEdit;
    Button2: TButton;
    Label25: TLabel;
    IDCode: TEdit;
    Label26: TLabel;
    ProductIDLengthEdit: TEdit;
    Label27: TLabel;
    Label28: TLabel;
    Label29: TLabel;
    warebasecodeedit: TEdit;
    Label30: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ComboBoxPortChange(Sender: TObject);
    procedure ButtonLinkClick(Sender: TObject);
    procedure ButtonRefreshClick(Sender: TObject);
    procedure EditSmsCentrolDblClick(Sender: TObject);
    procedure ButtondisconnectClick(Sender: TObject);
    procedure ButtonSendClick(Sender: TObject);
    procedure RadioClientNameClick(Sender: TObject);
    procedure RadioProductNameClick(Sender: TObject);
    procedure RadioProductIDClick(Sender: TObject);
    procedure ButtonQueryClick(Sender: TObject);
    procedure ButtonCancelClick(Sender: TObject);
    procedure ButtonAddClick(Sender: TObject);
    procedure ButtondelClick(Sender: TObject);
    procedure ButtonModifyClick(Sender: TObject);
    procedure DBGrid1CellClick(Column: TColumn);
    procedure Button1Click(Sender: TObject);
    procedure ModifyLocalSetButtonClick(Sender: TObject);
    procedure RadioButtonAddClick(Sender: TObject);
    procedure RadioButtonModifyClick(Sender: TObject);
    procedure ButtonResultQueryClick(Sender: TObject);
    procedure EnterpriseRadioButtonClick(Sender: TObject);

  private
    { Private declarations }
 function Checkdatabase(ProductID:string): Boolean;
 function UpdateQuery(ProductID:string;QueryDate:string): string;
 function ReplayQuery(FromPhoneNumber:string;ProductID:string;QueryDate:string): Boolean;
 function CreateProductUID(IDNum:integer):string;
  public
  FilePath:string;
  Test:string;
  EnterpriseName:string;
  EnterpriseTel:string;
  ProductorIDCode:string;
  warebasecode:string;
  ProductorIDCodeLength:integer;
  ReturnResult:boolean;
  ComUsed:integer;
 procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;BufferLength: Word);
 procedure CreateComm();
 procedure Refreshsms();
 procedure RefreshsmsSecond(ReceiveMsg:string);
  end;

var
  MainForm: TMainForm;
  mscomm:TComm;

implementation
uses UnitEnDecode,unitIrdacomm,UnitSendmsg,UnitProcessQuery;
{$R *.dfm}
 procedure GetCommList(CommList:TStrings);
var
   reg:tregistry;
   i:integer;
   s:string;
   list:TStringList;
begin
   List:=Tstringlist.create;
   reg:=tregistry.create;
   reg.RootKey:=HKEY_LOCAL_MACHINE;
   reg.OpenKey('Hardware\DeviceMap\SerialComm',true);
   reg.GetValueNames(List);
   for i:=0 to List.Count-1 do
   begin
      s:=List[i];
      if (s='')or(strlicomp(@s[1],'com',3)<>0) then
      begin
         s:=reg.ReadString(s);
         if (s='')or(strlicomp(@s[1],'com',3)<>0) then continue;
      end;
      commList.Add(s);
   end;
   reg.closekey;
   reg.free;
   List.free;
end;

procedure LeftTrimCR(var s:string);
var
   i:integer;
begin
   for i:=1 to length(s) do
   begin
      if s[1] in [#$A,#$D] then delete(s,1,1)
      else break;
   end;
end;

procedure RightTrimCR(var s:string);
var
   i:integer;
begin
   for i:=length(s) downto 1 do
   begin
      if s[i] in [#$A,#$D] then delete(s,i,1)
      else break;
   end;
end;

procedure splite(s,substring:string;var Pre,Next:string);
var
   i:integer;
begin
   i:=pos(substring,s);
   if i=0 then
   begin
      Pre:=s;
      Next:='';
   end
   else begin
      Pre:=copy(s,1,i-1);
      Next:=copy(s,i+1,length(s)-i);
   end;
end;

procedure TMainForm.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var
   s:string;
   sendorincept:integer;
   msg:string;
   smAddress:string;
begin
   RecString:='';
   setlength(s,BufferLength);
   move(buffer^,pchar(s)^,BufferLength);
   if (s<>(#$d#$a#$d#$a+'ok'+#$d#$a)) then
      RecString:=RecString+s;
   if pos('CMTI',s)<>0 then
   begin
     msg:=SendCommand('AT+CMGL='+'0',2000);
     RefreshsmsSecond(msg);
   end ;
 end;
procedure TMainForm.CreateComm();
begin
   MsComm:=TComm.create(MainForm);
   MsComm.OnReceiveData:=Comm1ReceiveData;
   with MsComm do
   begin
//    BaudRate := 38400;
    ParityCheck := False;
    Outx_CtsFlow := False;
    Outx_DsrFlow := False;
    DtrControl := DtrEnable;
    DsrSensitivity := False;
    TxContinueOnXoff := True;
    Outx_XonXoffFlow := True;
    Inx_XonXoffFlow := True;
    ReplaceWhenParityError := False;
    IgnoreNullChar := False;
    RtsControl := RtsEnable;
    XonLimit := 500;
    XoffLimit := 500;
//    ByteSize := _8;
//    Parity := None;
//    StopBits := _1;
    XonChar := #17;
    XoffChar := #19;
    ReplacedChar := #0;
    ReadIntervalTimeout := 100;
    ReadTotalTimeoutMultiplier := 0;
    ReadTotalTimeoutConstant := 0;
    WriteTotalTimeoutMultiplier := 0;
    WriteTotalTimeoutConstant := 0;
   end;
end;
procedure TMainForm.FormCreate(Sender: TObject);
var
  myReg:TRegistry;
begin
   FilePath:=ExtractFilePath(Application.ExeName);

   ReturnResult:=true;

   EnterpriseTel:='0536-5994993';

   EnterpriseName:='凤凰科技';
   ProductorIDCode := '12';
   warebasecode:='34';
   ProductorIDCodeLength:=16;
   ComUsed:=0;
  myReg:=TRegistry.create;
  myReg.RootKey:=HKEY_LOCAL_MACHINE;
  try
    if (myReg.OpenKey('\Software\Phinex',true)) then
    begin
      if not(myReg.ValueExists('DBPath')) then
      begin
      myReg.WriteString('DBPath',FilePath);
      end
      else
      begin
      FilePath:=myReg.ReadString('DBPath');
      end;

      if not(myReg.ValueExists('ReturnResult')) then
      begin
      myReg.WriteBool('ReturnResult',ReturnResult);
      end
      else
      begin
      ReturnResult:=myReg.ReadBool('ReturnResult');
      end;

      if not(myReg.ValueExists('EnterpriseName')) then
      begin
      myReg.WriteString('EnterpriseName',EnterpriseName);
      end
      else
      begin
      EnterpriseName:=myReg.ReadString('EnterpriseName');
      end;

      if not(myReg.ValueExists('EnterpriseTel')) then
      begin
      myReg.WriteString('EnterpriseTel',EnterpriseTel);
      end
      else
      begin
      EnterpriseTel:=myReg.ReadString('EnterpriseTel');
      end;

      if not(myReg.ValueExists('ComUsed')) then
      begin
      myReg.WriteInteger('ComUsed',ComUsed);
      end
      else
      begin
      ComUsed:=myReg.ReadInteger('ComUsed');
      end;

      if not(myReg.ValueExists('ProductorIDCode')) then
      begin
      myReg.WriteString('ProductorIDCode',ProductorIDCode);
      end
      else
      begin
      ProductorIDCode:=myReg.ReadString('ProductorIDCode');
      end;

      if not(myReg.ValueExists('WareBaseCode')) then
      begin
      myReg.WriteString('WareBaseCode',WareBaseCode);
      end
      else
      begin
      WareBaseCode:=myReg.ReadString('WareBaseCode');
      end;

      if not(myReg.ValueExists('ProductorIDCodeLength')) then
      begin
      myReg.WriteInteger('ProductorIDCodeLength',ProductorIDCodeLength);
      end
      else
      begin
      ProductorIDCodeLength:=myReg.ReadInteger('ProductorIDCodeLength');
      end;

      myReg.CloseKey;
    end;
  finally
    myReg.Free;
  end;
  if(ReturnResult) then
  begin
      ReturnResultCheckBox.Checked := true;
  end
  else
  begin
      ReturnResultCheckBox.Checked := false;
   end;
   Mainform.LocalDatabasePath.Text:= FilePath;
   MainForm.EnterpriseTelEdit.Text:= EnterpriseTel;
   MainForm.EnterpriseNameEdit.Text:= EnterpriseName;
   MainForm.ProductIDLengthEdit.Text:= IntToStr(ProductorIDCodeLength);
   MainForm.IDCode.Text:= ProductorIDCode;
   MainForm.warebasecodeedit.Text:=WareBaseCode;
   if ADOConnection1.Connected then              //若已连接，则断开连接
   ADOConnection1.Connected:=false;

   ADOConnection1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+MainForm.FilePath+'ClientInfo.mdb;Persist Security Info=False';
   ADOQuery1.Connection:=ADOConnection1;
   ADOQuery2.Connection:=ADOConnection1;
   DataSource1.DataSet:=ADOQuery1;
   DataSource2.DataSet:=ADOQuery2;
   PageControl1.ActivePageIndex:=0;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
   comboboxPort.items.add('红外');
   GetCommList(comboboxPort.items);
   if comboboxPort.Items.count>0 then
      comboboxPort.itemindex:=ComUsed;
{   try
      MSComm:=TMSComm.Create(self);
      MSComm.Parent:=self;
      MSComm.OnComm:=MSCommComm;
      MSComm.InputLen:=0;
   except
      showmessage('文件不完整!');
      halt;
   end; }
   CreateComm();
    RadioClientName.Checked :=false;
    EnterpriseQueryEdit1.Text:= EnterPriseName;
    RadioProductName.Checked:=false;
    RadioProductID.Checked:=false;
    EditClientName.Enabled:=true;
    EditProductName.Enabled:=false;
    EditProductID.Enabled:=false;
    ButtonAdd.Enabled:=False;