📄 ucomtest.pas

📁 This program I use to tested serial com and AT Command for testing GPRS for SIM300 GSM module
💻 PAS
📖 第 1 页 / 共 2 页
字号:
12 下一页
unit uCOMTest;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, CPort, StdCtrls, CPortCtl, Buttons, ComCtrls, Menus, ExtCtrls,
  Registry, StrUtils, GSM_SMS, ToolWin, ImgList, XPMan;

const
  WM_APP1 = WM_APP+1;
  TIMEOUT_AT_RESPONSE = 3;

type
  CharBuff = array[0..255] of char;

  TForm1 = class(TForm)
    ComPort: TComPort;
    mReceive: TMemo;
    Memo2: TMemo;
    Label1: TLabel;
    TextMessage: TMemo;
    Label2: TLabel;
    Label3: TLabel;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    cbASCII: TCheckBox;
    ComLed1: TComLed;
    ComLed2: TComLed;
    ComLed3: TComLed;
    ComLed4: TComLed;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    ComLed7: TComLed;
    Label10: TLabel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    Label8: TLabel;
    Label9: TLabel;
    edAddr: TEdit;
    Label11: TLabel;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    StatusBar1: TStatusBar;
    Close1: TMenuItem;
    cbCRLF: TCheckBox;
    ComboBox1: TComboBox;
    rb1: TRadioButton;
    rb2: TRadioButton;
    rb3: TRadioButton;
    SMS1: TMenuItem;
    PDUMode: TMenuItem;
    EXTMode: TMenuItem;
    Label12: TLabel;
    Label14: TLabel;
    smReply: TMenuItem;
    smFlash: TMenuItem;
    smReport: TMenuItem;
    CheckBox1: TCheckBox;
    Button1: TButton;
    Radio1: TMenuItem;
    XDelay1: TMenuItem;
    PTT: TMenuItem;
    RTSOn1: TMenuItem;
    RTSOff1: TMenuItem;
    DTROn1: TMenuItem;
    DTROff1: TMenuItem;
    None1: TMenuItem;
    CheckBox2: TCheckBox;
    PopupMenu1: TPopupMenu;
    CTRLZ1: TMenuItem;
    N1: TMenuItem;
    SendText1: TMenuItem;
    ctrlz2: TMenuItem;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ImageList1: TImageList;
    N2: TMenuItem;
    HEXSign: TMenuItem;
    N3: TMenuItem;
    PastefromClipboard1: TMenuItem;
    LRC1: TMenuItem;
    XPManifest1: TXPManifest;
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure ComPortAfterClose(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure ComPortAfterOpen(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ComPortRxChar(Sender: TObject; Count: Integer);
    procedure Memo2KeyPress(Sender: TObject; var Key: Char);
    procedure Button7Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure TextMessageChange(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure LabelClick(Sender: TObject);
    procedure Close1Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure mReceiveChange(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure XDelay1Click(Sender: TObject);
    procedure CTRLZ1Click(Sender: TObject);
    procedure SendText1Click(Sender: TObject);
    procedure ctrlz2Click(Sender: TObject);
    procedure PastefromClipboard1Click(Sender: TObject);
    procedure LRC1Click(Sender: TObject);
  private
    { Private declarations }
    Ftimeout: Cardinal;
    FResponseData: WideString;
    function DecToASCIIHex(data: integer): string;
    procedure GetATCmdOkResponse(Const ErrorMsg: string);
    procedure GetATCmdlinefeedResponse(const ErrorMsg: string);
    procedure asciiHexToChar(s: string; var ch: CharBuff; var count: byte);
  public
    { Public declarations }
    function SendSMSinTextMode(aSMSAddress, aMessage: String): boolean;
    function SendSMSinPDUMode(dest, str: string): boolean;
    function GetNextLongSMSRefference: string;
    function SendGetData(Txt, Limit: String; const WaitResponseTime: DWord = TIMEOUT_AT_RESPONSE): String;
  end;

const
  // AT Command Response Strings Constants
  sBUSY      = 'BUSY';
  sCONNECT   = 'CONNECT';
  sNOANSWER  = 'NO ANSWER';
  sNOCARRIER = 'NO CARRIER';
  sRING      = 'RING';
  sOK        = 'OK';
  sERROR     = 'ERROR';

  // String and Character Constants
  CRLF  = #13#10;
  CR    = #13;
  LF    = #10;

var
  Form1: TForm1;
  Item: TStrings;
  LimitStr, response: string;
  ReadyState: boolean;
  DlyWaitResp: DWord;

implementation

{$R *.dfm}

uses ClipBrd, Masks, DateUtils, Unit2, Unit3;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  ComPort.LoadSettings(stRegistry, 'HKEY_LOCAL_MACHINE\Software\Avec\COMTest');

  Item := TStringList.Create;

  Ftimeout := 6000;
end;

procedure TForm1.GetATCmdlinefeedResponse(const ErrorMsg: string);
var
  aResponse: string;
  aStart: Cardinal;
begin
  LimitStr := ErrorMsg;
  aStart := GetTickCount;
  aResponse := Uppercase(Response);
  while (Pos('>'#32, aResponse) <= 0) do
  begin
    if (aStart + Ftimeout) < GetTickCount then
      raise exception.Create('Timeout!')
    else if (Pos(#13#10'ERROR'#13#10, aResponse) > 0) then
      raise exception.Create(ErrorMsg);
    aResponse := aResponse + Uppercase(Response);
  end;
end;

procedure TForm1.GetATCmdOkResponse(const ErrorMsg: String);
var
  aResponse: String;
  aStart: Cardinal;
begin
  LimitStr := ErrorMsg;
  aStart := GetTickCount;
  aResponse := Uppercase(Response);

  while (Pos(#13#10'OK'#13#10, aResponse) <= 0) do
  begin
    if (aStart + Ftimeout) < GetTickCount then
      raise exception.Create('Timeout!')
    else
    if (Pos(#13#10'ERROR'#13#10, aResponse) > 0) or
        MatchesMask(aResponse, '*'#13#10'+CMS ERROR: *'#13#10'*') then
      raise exception.Create(ErrorMsg);

    aResponse := aResponse + Uppercase(Response);
  end;
end;

function TForm1.SendSMSinTextMode(aSMSAddress, aMessage: String): boolean;
begin
  if not ComPort.Connected then
    raise Exception.Create('Not Connected!');

  {to reset completely previous request}
  ComPort.WriteStr(#27);

  {starting}
  SendGetData('AT'#13, sOK);

  {Message Format}
  if Pos('ERROR', SendGetData('AT+CMGF=1'#13, sOK)) > 0 then
    raise exception.Create('AT+CMGF=1 command error!');

  {Send Message}
  if Pos('ERROR', SendGetData('AT+CMGS="'+edAddr.Text+'"'#13, '>')) > 0 then
    raise exception.Create('AT+CMGS command error!');

  if Pos('OK', SendGetData(aMessage + #26, sOK, 10)) > 0 then
    result := True
  else
    result := False;
end;

function TForm1.SendSMSinPDUMode(dest, str: string): boolean;
var
  PDU, udhi, smstotal,
  smsref, STemp, s: string;
  sms: TSMS;
  i, p: integer;
begin
  if not ComPort.Connected then
    raise Exception.Create('Not Connected!');

  {to reset completely previous request}  ComPort.WriteStr(#27);

  {starting}
  SendGetData('AT'#13, sOK);

  {Message Format}
  if Pos('ERROR', SendGetData('AT+CMGF=0'#13, sOK)) > 0 then
    raise exception.Create('AT+CMGF=0 command error!');

  {Send Message}
  sms := TSMS.Create;  sms.Number := dest;  sms.RequestReply := smReply.Checked;
  sms.FlashSMS := smFlash.Checked;
  sms.StatusRequest := smReport.Checked;
  sms.dcs := -1;

  Result := true;

  if Length(str) <= 160 then  begin    sms.Text := str;    sms.UDHI := '';
    pdu := sms.PDU;
    s := SendGetData('AT+CMGS=' + IntToStr(sms.tplength) + #13, '>');
    s := SendGetData(PDU + #$1A, sOK, 10);
    Result := Pos(sOK, s) > 0;
  end else
  begin
    p := 153;
    smstotal := IntToHex((length(str) div p) + 1, 2);
    smsRef := GetNextLongSMSRefference;
    udhi := '050003' + smsRef + smstotal;
    for i := 1 to StrToInt('$' + smstotal) do
    begin
      STemp := Copy(str, 1, p);
      Delete(str, 1, p);
      sms.Text := STemp;
      sms.UDHI := udhi + IntToHex(i, 2);
      pdu := sms.PDU;
      s := SendGetData('AT+CMGS=' + IntToStr(sms.tplength) + #13, '>');
      s := SendGetData(PDU + #$1A, sOK, 10);
      Result := pos(sOK, s) > 0;
    end;
  end;
  sms.Free;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  ComPort.ShowSetupDialog;
  ComPort.StoreSettings(stRegistry, 'HKEY_LOCAL_MACHINE\Software\Avec\COMTest');
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  ComPort.Open;
end;

procedure TForm1.ComPortAfterClose(Sender: TObject);
begin
  Button1.Enabled := False;
  Button2.Enabled := False;
  Button3.Enabled := True;
  Button4.Enabled := True;
  Button5.Enabled := False;
  Button7.Enabled := False;
  Form3.Button2.Enabled := False;
  Form3.Button6.Enabled := False;

  SpeedButton1.Enabled := False;
  SpeedButton2.Enabled := False;

  CheckBox1.Enabled := False;
end;

procedure TForm1.ComPortAfterOpen(Sender: TObject);
begin
  Button1.Enabled := True;
  Button2.Enabled := True;
  Button3.Enabled := False;
  Button4.Enabled := False;
  Button5.Enabled := True;
  Button7.Enabled := True;
  Form3.Button2.Enabled := True;
  Form3.Button6.Enabled := True;

  SpeedButton1.Enabled := True;
  SpeedButton2.Enabled := True;

  CheckBox1.Enabled := True;

  if Pos(sOK, SendGetData('AT'#13, sOK)) <> 0 then
  begin
    SendGetData('AT+CGMI'#13, sOK);
    SendGetData('AT+GMM'#13, sOK);
    SendGetData('AT+CGSN'#13, sOK);
    SendGetData('AT+COPS?'#13, sOK);
    SendGetData('AT+CSCA?'#13, sOK);
  end;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  mReceive.Clear;
  Memo2.Clear;
  TextMessage.Clear;

  ComboBox1.Clear;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if ComPort.Connected then
    ComPort.Close;
end;

function TForm1.DecToASCIIHex(data: integer): string;
const
  HexTable: array[0..16] of Char=('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F','0');
begin
  Result:=HexTable[Data div 16]+HexTable[Data mod 16];
12 下一页
⌨️ 快捷键说明

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