ucomtest.pas

This program I use to tested serial com and AT Command for testing GPRS for SIM300 GSM module

end;

procedure TForm1.ComPortRxChar(Sender: TObject; Count: Integer);
var
  sms : tSMS;
  response: string;
  i: integer;
  a: char;
begin
  for i := 1 to Count do
  begin
    ComPort.Read(a, 1);
    response := response + a;
    if cbASCII.Checked then
    begin
      if not cbCRLF.Checked then
      begin
        if (a = #13) then
          mReceive.Text := mReceive.Text + '<CR>'
        else if (a = #10) then
          mReceive.Text := mReceive.Text + '<LF>'
        else if Ord(A) in [0..31] then
          mReceive.Text := mReceive.Text + '[' + IntToStr(Ord(a)) + ']'
        else
          mReceive.Text := mReceive.Text + a;
      end
      else
        mReceive.Text := mReceive.Text + a;
    end
    else
      mReceive.Text := mReceive.Text + DecToASCIIHex(Ord(a)) + ' ';
  end;

  FResponseData := FResponseData + response;

  if Pos(sERROR, FResponseData) <> 0 then ReadyState := True;
  if Pos(sNOCARRIER, FResponseData) <> 0 then ReadyState := True;
  if Pos(sNOANSWER, FResponseData) <> 0 then ReadyState := True;
  if Pos(sBUSY, FResponseData) <> 0 then ReadyState := True;
(*
  if Pos('+CBM:', FResponseData) <> 0 then
  begin
    st := copy(FResponseData, pos('+CBM:', FResponseData) + 22, 88);
    sms := TSMS.Create;
    sms.PDU := '0011000A8180813455720000FF88' + st;
    if sms.Text <> '' then
      StatusBar1.Panels.Items[0].Text := ' BTS : ' + sms.Text;
    sms.Free;
    ReadyState := True;
  end;
*)
  if (not ReadyState) and (Pos(LimitStr, FResponseData) <> 0) Then
    ReadyState := True;
end;

procedure TForm1.Memo2KeyPress(Sender: TObject; var Key: Char);
begin
  if ComPort.Connected then
    ComPort.Write(Key, 1);
end;

procedure TForm1.Button7Click(Sender: TObject);
var
  str: string;
  count: byte;
  req: CharBuff;
begin
  if HEXSign.Checked then
  begin
    str := ComboBox1.Text;
    asciiHexToChar(Str, req, count);
    ComPort.Write(req, count);
  end
  else
  begin
    if rb1.Checked then
    begin
      str := ComboBox1.Text + #13+#10;
      Memo2.Lines.Text := Memo2.Lines.Text + ComboBox1.Text + '<CR><LF>';
    end
    else if rb2.Checked then
    begin
      str := ComboBox1.Text + #13;
      Memo2.Lines.Text := Memo2.Lines.Text + ComboBox1.Text + '<CR>';
    end
    else
    begin
      str := ComboBox1.Text;
      Memo2.Lines.Text:= Memo2.Lines.Text + ComboBox1.Text;
    end;

    ComPort.WriteStr(str);
  end;
//  ComboBox1.Items.Add(ComboBox1.Text);
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  SpeedButton1.Caption := 'dtr';
  ComPort.SetDTR(False);
  if SpeedButton1.Down then
  begin
    SpeedButton1.Caption:= 'DTR';
    ComPort.SetDTR(True);
  end;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  SpeedButton2.Caption := 'rts';
  ComPort.SetDTR(False);
  if SpeedButton2.Down then
  begin
    SpeedButton2.Caption:= 'RTS';
    ComPort.SetDTR(True);
  end;
end;

procedure TForm1.TextMessageChange(Sender: TObject);
begin
  if (TextMessage.Lines.Count <> 0){ and (Label8.Caption <> '0')} then
  begin
    Label8.Caption := IntToStr(160 - (Length(TextMessage.Lines.Text) -
    160 * Trunc(Length(TextMessage.Lines.Text) / 160)));
    Label14.Caption := IntToStr(Trunc(Length(TextMessage.Lines.Text) / 160) + 1);
  end
  else
  begin
    Label8.Caption := '160';
    Label14.Caption :=  '0';
    beep;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  c: string;
  i: integer;
begin
  c := edAddr.Text;

  if c = '' then
  begin
    ShowMessage('Type the destination number');
    exit;
  end;

  if Pos('(', c) <> 0 then
    c := Copy(c, 1, Pos('(', c)-1);
  c := AnsiReplaceStr(c, ',', #13#10);

  Item.Text := c;
  if PDUMode.Checked then
    for i := 0 to Item.Count - 1 do
    begin
      c := trim(Item.Strings[i]);
      if (SendSMSinPDUMode(c, TextMessage.Text)) then
        ShowMessage('Sending message to ' + c + ' Successful.')
      else
        ShowMessage('Sending message to ' + c + ' Failed.');
    end
  else
    for i := 0 to Item.Count - 1 do
    begin
      c := trim(Item.Strings[i]);
      if (SendSMSinTextMode(edAddr.Text, TextMessage.Text)) then
        ShowMessage('Sending message to ' + c + ' Successful.')
      else
        ShowMessage('Sending message to ' + c + ' Failed.');
    end
end;

function TForm1.SendGetData(Txt, Limit: String;
  const WaitResponseTime: DWord): String;
var
  elapsedTime: DWord;
  waktu: TDateTime;
begin
  Memo2.Lines.Add(Txt);

  FResponseData := '';
  ReadyState := False;
  LimitStr := Limit;
  waktu := Now;

  DlyWaitResp := WaitResponseTime * 1000;

  ComPort.WriteStr(Txt);
  while (not ReadyState) and (SecondsBetween(waktu, Now) < WaitResponseTime) do
    Application.ProcessMessages;

  Result := FResponseData;
  FResponseData := '';
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
    Button7.Click;
end;

procedure TForm1.LabelClick(Sender: TObject);
begin
  case TLabel(Sender).Tag of
    1: mReceive.Clear;
    2: Memo2.Clear;
    3: TextMessage.Clear;
  end;
end;

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

procedure TForm1.Button5Click(Sender: TObject);
begin
  ComPort.Close;
end;

function TForm1.GetNextLongSMSRefference: string;
var
  mref: integer;
begin
  randomize;
  mref := 1 + random(252);
  with TRegistry.Create do
    try
      if OpenKey('\Software\AvecProgram.com\DisplayApp', true) then
        try
          if ValueExists('MessageRef') then
            mref := ReadInteger('MessageRef');
          if (mref < 0) or (mref >= 255) then mref := 0;
          inc(mref);
          WriteInteger('MessageRef',mref);
        finally
          CloseKey;
        end;
    finally
      Free;
    end;
  Result := IntToHex(mref, 2);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Item.Free;
end;

procedure TForm1.mReceiveChange(Sender: TObject);
begin
  if mReceive.Lines.Count > 100 then
    mReceive.Clear;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.Checked then
    SendGetData('AT+CNMI=1,1,2,0,1'#13, sOK)
  else
    SendGetData('AT+CNMI=0,0,0,0,1'#13, sOK);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  sms : tSMS;
  st: string;
begin
  st := SendGetData('AT+CSCB=1,"",""'#13, '00'#13#10);
//  st := SendGetData('AT+CSCB=0,"50",""'#13, '00'#13#10);  //sim300
  st := copy(st, pos('+CBM:', st) + 22, 88);
  sms := TSMS.Create;
  sms.PDU := '0011000A8180813455720000FF88' + st;
  if sms.Text <> '' then
    StatusBar1.Panels.Items[0].Text := ' BTS : ' + sms.Text;
  sms.Free;
end;

procedure TForm1.XDelay1Click(Sender: TObject);
begin
  frmDelay.ShowModal;
end;

procedure TForm1.CTRLZ1Click(Sender: TObject);
begin
  ComPort.WriteStr(#$1A);
  Memo2.Lines.Text := Memo2.Lines.Text + ComboBox1.Text + '<CTRL-Z>';
end;

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

procedure TForm1.ctrlz2Click(Sender: TObject);
begin
  ComPort.WriteStr(ComboBox1.Text + #13#10#$1A);
  Memo2.Lines.Text := Memo2.Lines.Text + ComboBox1.Text + '<CTRL-Z>';
end;

procedure TForm1.asciiHexToChar(s: string; var ch: CharBuff; var count: byte);
var
  b: byte;
  i, err: integer;
begin
  i := 1; count := 0;
  while i < Length(s)+1 do
  begin
    if s[i] = '$' then
    begin
      Val(Copy(s, i, 3), b, err);
      ch[count] := Chr(b);
      Inc(i, 2);
    end
    else
      ch[count] := s[i];

    Inc(i);
    Inc(count);
  end;
end;

procedure TForm1.PastefromClipboard1Click(Sender: TObject);
var
  Clipboard: TClipboard;
  st: string;
  i, p: integer;
begin
  Clipboard := TClipboard.Create;

  ComboBox1.Items.Text := Clipboard.AsText;
  for i := 0 to ComboBox1.Items.Count -1 do
  begin
    st := ComboBox1.Items[i];
    p := Pos('//', st);
    if p <> 0 then
      ComboBox1.Items[i] := Trim(Copy(st, 1, p-1));
  end;

  Clipboard.Free;
end;

procedure TForm1.LRC1Click(Sender: TObject);
var
  i, err: integer;
  b: byte;
  st, HexStr: string;
  ChkSum: word;
begin
  st := ComboBox1.Text;
  if not HEXSign.Checked then
  begin
    HexStr := '';
    ChkSum := 0;
    st := Copy(st, 2, Length(st));
    for i := 1 to Length(st) div 2 do
    begin
      Val('$'+Copy(st, 2*i+1, 2), b, err);
      ChkSum := ChkSum + b;
    end;

    ChkSum := $100 - (ChkSum mod $100);
    if ChkSum = $100 then ChkSum := 0;
    HexStr := ':' + st + IntToHex(ChkSum, 2) + #13#10;

    ComPort.WriteStr(HexStr);
    Memo2.Lines.Text := HexStr;
  end
end;

end.