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

📄 ufmain.~pas

📁 通达OA短信程序 通达OA短信程序
💻 ~PAS
字号:
unit UFMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, Menus, ExtCtrls, ComCtrls, ToolWin, DB, ADODB;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    StatusBar1: TStatusBar;
    GroupBox2: TGroupBox;
    Label3: TLabel;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Memo1: TMemo;
    Edit1: TEdit;
    Memo2: TMemo;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Timer1: TTimer;
    Timer2: TTimer;
    FADOConnection: TADOConnection;
    FQuery: TADOQuery;
    btStart: TButton;
    btStop: TButton;
    procedure N4Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure btStartClick(Sender: TObject);
    procedure btStopClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private

  public
     function TrimMobile(s:String):String;
  end;


var
  Form1: TForm1;



implementation

uses
  UFHelp, UFConfig, USMS;



{$R *.dfm}

procedure TForm1.N4Click(Sender: TObject);
begin
  Form1.Close;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
  Form2.Show;
end;

procedure TForm1.N6Click(Sender: TObject);
begin
  Form3.Show;
end;

procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if Key = Word(#13) then
  begin
    BitBtn1.Click;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  getBuffer:array[1..20] of char;
  RunDir:string;
  dbuser,dbsource:string;
begin
   RunDir := ExtractFileDir(Application.ExeName);
  //Form1.Caption := Application.Title;
   if Timer1.Interval <> (SMS.SMSSet.ChkMsgDelay*1000) then
  begin
    Timer1.Interval := SMS.SMSSet.ChkMsgDelay*1000;
    Timer2.Interval := SMS.SMSSet.ChkMsgDelay*1000;
  end;
  if not SMS.SComm.m_Opened then
  begin
    Memo1.Lines.Add('init fail!');
    Memo1.Enabled := FALSE;
    Memo2.Enabled := FALSE;
    Edit1.Enabled := FALSE;
    BitBtn1.Enabled := FALSE;
    BitBtn2.Enabled := FALSE;
  end else
  begin
    Memo1.Lines.Clear;
    Memo1.Enabled := TRUE;
    Memo2.Enabled := TRUE;
    Edit1.Enabled := TRUE;
    BitBtn1.Enabled := TRUE;
    BitBtn2.Enabled := TRUE;
  end;
  FADOConnection := TADOConnection.Create(Application);
  GetPrivateProfileString('DB','USER','',PChar(@getBuffer[1]),500,Pchar(RunDir+'\'+IniPath));
  dbuser := Copy(getBuffer,1,strlen(@getBuffer[1]));
  GetPrivateProfileString('DB','SOURCE','',PChar(@getBuffer[1]),500,Pchar(RunDir+'\'+IniPath));
  dbsource := Copy(getBuffer,1,strlen(@getBuffer[1]));

  FADOConnection.ConnectionString := 'Provider=MSDASQL.1;Persist Security Info=False;User ID='+dbuser+';Data Source='+dbsource;
  FADOConnection.LoginPrompt := False;
  FADOConnection.Connected := True;
  FQuery := TADOQuery.Create(Application);
  FQuery.Connection := FAdoconnection;

end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  Memo1.Lines.Clear;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  smsBuf:string;
  Mobile:string;
begin

  BitBtn1.Enabled := FALSE;

  if SMS.SComm.m_Opened then
  begin

    Mobile := SMS.area+TrimMobile(Edit1.Text);
    //MessageDlg(Mobile,mtInformation,[mbOk],0) ;
   // Mobile := Edit1.Text;
    {
    if length(Mobile) <> 13 then
    begin
      if Mobile = '86' then
        MessageDlg('please mobile number',mtInformation,[mbOk],0)
      else
        MessageDlg('mobile number erro!',mtInformation,[mbOk],0);
      BitBtn1.Enabled := TRUE;
      exit;
    end;
    }
    smsBuf := Memo1.Lines.GetText;
    if (length(smsBuf) > 70) and (SMS.SMSSet.SMSMode = 'PDU')
    or (length(smsBuf) >140) and (SMS.SMSSet.SMSMode ='Text') then
    begin
      MessageDlg('msg too length',mtInformation,[mbOk],0);
      BitBtn1.Enabled := TRUE;
      exit;
    end;
    if smsBuf = '' then
    begin
      MessageDlg('please content',mtInformation,[mbOk],0);
      Memo1.Lines.Clear;
      BitBtn1.Enabled := TRUE;
      exit;
    end;

    while SMS.Busy do;
    SMS.Busy := TRUE;
    if SMS.SendSMS(smsBuf,Mobile) then
    begin
      MessageDlg('send ok!',mtInformation,[mbOk],0);
      //Memo1.Lines.Clear;
    end else
    begin
     MessageDlg('send fail!',mtWarning,[mbOk],0);
     Memo1.Lines.Text := smsBuf;
    end;
    SMS.Busy := FALSE;
  end else
  begin
    MessageDlg('serial port erro!',mtError,[mbOk],0);
  end;
  BitBtn1.Enabled := TRUE;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  CheckResult:boolean;
  strTmp:string;
begin
  CheckResult := TRUE;
  if not SMS.SComm.m_Opened or not SMS.SMSSet.ChkNewMsg then exit;

  if SMS.Busy then exit;
  SMS.Busy := TRUE;
  while CheckResult do
  begin
    CheckResult := SMS.CheckNewSMS;
    if CheckResult then
    begin
      strTmp := '20'+copy(SMS.RxMsg.Date,1,2)+'-'+copy(SMS.RxMsg.Date,3,2)
                +'-'+copy(SMS.RxMsg.Date,5,2)+'      '+copy(SMS.RxMsg.Date,7,2)
                +':'+copy(SMS.RxMsg.Date,9,2)+':'+copy(SMS.RxMsg.Date,11,2);
      Memo2.Lines.Append('date:'+strTmp);
      Memo2.Lines.Append('number:'+copy(SMS.RxMsg.Mobile,1,14));
      Memo2.Lines.Append('content:'+SMS.RxMsg.SMSMsg);
      Memo2.Lines.Append('');

      with FQuery do
      begin

     SQL.Text := 'INSERT INTO sms3(PHONE,'
                +'CONTENT,SEND_TIME) VALUES(:PHONE,:CONTENT,now())' ;
     Parameters[0].Value := SMS.RxMsg.Mobile;
     Parameters[1].Value := SMS.RxMsg.SMSMsg;
    // Parameters[2].Value := SMS.RxMsg.SMSMsg;
     ExecSQL;
     end;

    end else
    begin
       Memo2.Lines.Append('No message!!!!!');
    end;
    sleep(300);
  end;
  SMS.Busy := FALSE;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
var
    phone,content,smsid:string;

begin
//Application.MessageBox('','dfasfdsfaads');
// ADOConnection1.

with FQuery do begin
   SQL.Text:='SELECT SMS_ID,PHONE,CONTENT FROM sms2 where SEND_FLAG=0';
   Open;
     if RecordCount = 0 then
     begin
      Memo1.Lines.Append('No message!!!');
      exit;
     end;

       smsid :=FieldByName('SMS_ID').AsString;
       phone :=FieldByName('PHONE').AsString;
       content :=FieldByName('CONTENT').AsString;
       while SMS.Busy do;
     SMS.Busy := TRUE;
    if SMS.SendSMS(content, SMS.area+TrimMobile(phone)) then
    begin
      //MessageDlg('send ok!',mtInformation,[mbOk],0);
      Memo1.Lines.Text:='send ok!';
      SQL.Text :='update sms2 set  SEND_FLAG=''1'',send_time=now() where SMS_ID=:SMS_ID';
      //SQL.Text :='update sms2 set  SEND_FLAG=''1'',send_time=now() where SMS_ID=1';
       Parameters[0].value:=smsid;
       ExecSQL;
    end else
    begin
      Memo1.Lines.Append('send fail!'+content+'   mobile:'+SMS.area+TrimMobile(phone));
      SQL.Text :='update sms2 set  SEND_FLAG=''2'',send_time=now() where SMS_ID=:SMS_ID';
      Parameters[0].value:=smsid;
       ExecSQL;
    end;
    SMS.Busy := FALSE;
       //Application.MessageBox(char)


end;
end;

procedure TForm1.btStartClick(Sender: TObject);
begin

//Timer1.Enabled:=true;
Timer2.Enabled:=true;
btStop.Enabled:=true;
btStart.Enabled:=false;
end;

procedure TForm1.btStopClick(Sender: TObject);
begin
    Timer1.Enabled:=false;
Timer2.Enabled:=false;
btStop.Enabled:=false;
btStart.Enabled:=true;
end;
function TForm1.TrimMobile(s:String):String;
begin
    result:=s;
    if (copy(s,1,1) = '0') then
    begin
       result:=copy(s,2,Length(s)-1);  
       //Application.MessageBox(result);
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 MessageDlg(TrimMobile(Edit1.Text),mtWarning,[mbOk],0);
end;

initialization
  begin
  SMS := TSMSControl.Create;                                                    //注意先后顺序
  if SMS.SComm.SComInit then
  begin
    SMS.ErrMsg := SMS.IniSMS;
    if SMS.ErrMsg < 0 then
    begin
      SMS.SComm.CloseSerial;
      case SMS.ErrMsg of
      -1:
        begin
          if MessageDlg('modem device erro'
               +chr(13)+'please check device。continue?',mtError,[mbYes,mbNo],0) = mrNo then
          Application.Terminate;
        end;
      -4:
        begin
          if MessageDlg('set GSM charset erro,please check set。',mtError,[mbYes,mbNo],0) = mrNo then
          Application.Terminate;
        end;
      -5:
        begin
          if MessageDlg('sms center erro,please SIM card and msg param。continue?',mtWarning,[mbYes,mbNo],0) = mrNo then
          Application.Terminate;
        end;
      -6:
        begin
          if MessageDlg('sms no Text send,please set sms param。continue?',mtWarning,[mbYes,mbNo],0) = mrNo then
          Application.Terminate;
        end;
      -7:
        begin
          if MessageDlg('sms no PDU,please set sms param。continue?',mtWarning,[mbYes,mbNo],0) = mrNo then
          Application.Terminate;
        end;
      -8:
        begin
          if MessageDlg('set PDU-UCS2 charset erro,continue?',mtWarning,[mbYes,mbNo],0) = mrNo then
          begin
            Application.Terminate;
          end;
        end;
      else
        begin
          Application.Terminate;
        end;
      end;
    end;
  end else
  begin
    if MessageDlg('serial port init fail!contine?',mtWarning,[mbYes,mbNo],0) = mrNo then
    begin
      Application.Terminate;
    end;
  end;
end;

finalization
begin
  SMS.SComm.CloseSerial;
end;

end.

⌨️ 快捷键说明

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