globepas.pas

一个delphi编写的收发短信源码, 使用了Cport控件,很实用

unit GlobePas;

interface

uses Forms, ActiveX, Windows, Classes, Sysutils, DB, IniFiles, ADODB,
  FileCtrl, Dialogs, ComCtrls, MutiDig, DataMoudal,
  Graphics, MMSystem;

const
  EndSign = #13#10;
  A1Sing = #26;
  CommName = '短信参数';
  KeyNoList = '卡号列表';
  SysName = '系统参数设置';

type
  TCommState = (SNone, SOpen, SClose, SBusy, SInit, Sidlesse, SLost, SSend);

  TCommPort = record
    Port:string;
    Phone:string;
    Rate:string;
  end;

  TTask = class(TPersistent)
  public
    TaskID:string;
    TaskName:string;
    TaskData:string;
    TaskWord:integer;
    WriteBack:integer;
    WriteTime:TDateTime;
    Tasktime:LongWord;
    TaskPhone:string;
  end;

var
  CommPort:TCommPort;
  CurDir:string;
  iniF:TIniFile;
  FRecTxt:string;
  CommState:TCommState;
  FTrasErrCount:integer;

  Task:TTask;
  TaskList:TList;
  PhoneIni:TIniFile;
  CotePhone:string; //短信中心号码
  ManagerPhone:string; //管理中心号码

  DataList:TList;

  EnableOpen:Boolean;
  fType:Boolean;

procedure Start;
procedure LoadParam;
procedure SaveParam;
function GetsubStr(Oldstr: string; mPos: integer; mStr: string = ','): string;
function StrSubCount(const Source, Sub: string): integer;
function unicodetoansi(unicode:string):string; //内码转ASCII码
function ansitoUnicode(ansi:string):string;
function GetSMSTel(mtel:string):string;
function DevSMSTel(mtel:string):string;

function CrcOfString(str:string):Byte;
function GenerateCRC(const buff; count:Integer):Byte;
function GetPDUSMSTime(mt:string):string;

function Bit7toASCII(Bit7_Str:string):string;


function Ucs2ToGBK(const InValue:string):string;

implementation
uses SendSMS;

procedure Start;
begin
  CurDir := GetCurrentDir + '\';
  iniF := TIniFile.Create(CurDir + 'SMS.ini');
  //  PhoneIni := TIniFile.Create(CurDir + 'Sys\SysParams.ini');
  if FileExists(CurDir + 'SMS.ini') then
    Loadparam;
  TaskList := TList.Create;
  DataList := TList.Create;
  EnableOpen := False;
  fType := True;
end;

procedure LoadParam;
begin
  with CommPort do
  begin
    Port := iniF.ReadString(CommName, 'CommPort', '');
    Phone := iniF.ReadString(CommName, 'CommPhone', '');
    Rate := iniF.ReadString(Commname, 'CommRate', '');
  end;
  {  ManagerPhone := PhoneIni.ReadString(SysName, 'ManagePhone', '');
    CotePhone := PhoneIni.ReadString(SysName, 'CotePhone', '');}
end;

procedure SaveParam;
begin
  with CommPort do
  begin
    iniF.WriteString(CommName, 'CommPort', Port);
    iniF.WriteString(CommName, 'CommPhone', Phone);
    iniF.WriteString(Commname, 'CommRate', Rate);
  end;
end;

function GetsubStr(Oldstr: string; mPos: integer; mStr: string = ','): string;
var
  i: integer;
begin
  Oldstr := OldStr + mStr;
  i := 1;
  while pos(mStr, Oldstr) <> 0 do
  begin
    if i = mPos then
    begin
      Result := Copy(OldStr, 1, pos(mStr, Oldstr) - 1);
      Break;
    end
    else
      Delete(Oldstr, 1, pos(mStr, Oldstr));
    inc(i);
  end;
end;

function StrSubCount(const Source, Sub: string): integer;
var
  Buf: string;
  i: integer;
  Len: integer;
begin
  Result := 0;
  Buf := Source;
  i := Pos(Sub, Buf);
  Len := Length(Sub);
  while i <> 0 do
  begin
    Inc(Result);
    Delete(Buf, 1, i + Len - 1);
    i := Pos(Sub, Buf);
  end;
end;

//内码转ASCII码

function unicodetoansi(unicode:string):string;
var
  s:string;
  i:integer;
  j, k:string[2];
  function readhex(astring:string):integer;
  begin
    result := strtoint('$' + Astring)
  end;
begin
  i := 1;
  s := '';
  while i < length(unicode) do
  begin
    j := copy(unicode, i + 2, 2);
    k := copy(unicode, i, 2);
    i := i + 4;
    s := s + char(readhex(j)) + char(readhex(k));
  end;
  if s <> '' then
    s := widechartostring(pwidechar(s + #0#0#0#0))
  else
    s := '';
  result := s;
end;

//ASCII码转内码

function ansitoUnicode(ansi:string):string;
var
  s:string;
  i:integer;
  j, k:string[2];
  a:array[1..1000] of char;
begin
  s := '';
  stringtowidechar(ansi, @(a[1]), 500);
  i := 1;
  while ((a[i] <> #0) or (a[i + 1] <> #0)) do
  begin
    j := inttohex(integer(a[i]), 2);
    k := inttohex(integer(a[i + 1]), 2);
    s := s + k + j;
    i := i + 2;
  end;
  result := s;
end;

//手机号码转为PDU中手机号

function GetSMSTel(mtel:string):string;
var
  i:integer;
  mst:string;
begin
  mst := '';
  for i := 1 to (length(mtel) div 2) do
    mst := mst + mtel[2 * i] + mtel[2 * i - 1];
  if (length(mtel) mod 2) <> 0 then
    mst := mst + 'F' + mtel[length(mtel)];
  if (copy(mst, 1, 2) <> '68') and (Copy(mst, 1, 3) <> '010') then
    mst := '68' + mst;
  result := mst;
end;

//取PDU短信中手机号码

function DevSMSTel(mtel:string):string;
var
  i:integer;
  mst:string;
begin
  mst := '';
  for i := 1 to (length(mtel) div 2) do
    mst := mst + mtel[2 * i] + mtel[2 * i - 1];
  if copy(mst, 1, 2) = '86' then
    delete(mst, 1, 2);
  if (length(mst) > 11) and (Copy(mst, 1, 3) <> '106') then
    mst := copy(mst, 1, 11);
  result := mst;
end;

{--------------------------------------------------------------------------
function GenerateCRC
功能： 计算指定的缓冲区内特定长度字节的CRC8校验。 X8 + X4 + X1
输入： const buff 缓冲区首地址
       count: Integer  需计算校验的字节个数
输出： Byte CRC检验结果。 本CRC校验与iButton检验计算方法相同。
---------------------------------------------------------------------------}

function GenerateCRC(const buff; count:Integer):Byte;
type
  TBytes = array[0..MaxInt - 1] of Byte;
var
  i, j, data, shdata:Integer;
  CRC:Byte;
  Carry, oldCarry:Boolean;
begin
  CRC := 0;
  for i := 0 to count - 1 do
  begin
    data := TBytes(buff)[i];
    shdata := data;
    for j := 8 downto 1 do
    begin
      data := data xor CRC;
      carry := (data and 1) = 1;
      if carry then
        CRC := CRC xor $18;

      oldCarry := carry;
      CRC := CRC shr 1;
      if oldCarry then
        CRC := CRC or $80;

      data := shdata;
      if (data and 1) = 1 then
        data := (data shr 1) or $80
      else
        data := (data shr 1);
      shdata := data;
    end;
  end;
  Result := CRC;
end;

{--------------------------------------------------------------------------
function CrcOfString
功能： 计算指定的字符串的CRC校验。
输入： str: string 要校验的字符串
输出： Byte CRC检验结果。
---------------------------------------------------------------------------}

function CrcOfString(str:string):Byte;
begin
  Result := GenerateCRC(Str[1], Length(Str));
end;

function GetPDUSMSTime(mt:string):string;
var
  mtt, mst:string;
  i:integer;
begin
  mst := '';
  for i := 1 to (length(mt) div 2) do
    mst := mst + mt[2 * i] + mt[2 * i - 1] + '-';
  mtt := stringreplace(copy(mst, 10, 8), '-', ':', [rfReplaceAll]) + ':000';
  mst := '20' + copy(mst, 1, 8) + ' ' + mtt;
  result := mst;
end;

function Bit7toASCII(Bit7_Str:string):string;
var
  i, j:integer;
  tmp7, nmst_7, mst_7, mst_8:Byte;
  mst:string;
begin
  result := '';
  nmst_7 := 0;
  j := 0;
  for i := 0 to (length(Bit7_str) div 2) - 1 do
  begin
    j := j + 1;
    if (j mod 8) = 0 then
    begin
      j := 1;
      mst_8 := nmst_7;
      mst := mst + inttohex(mst_8, 2);
      nmst_7 := 0;
    end;
    mst_7 := strtoint('$' + bit7_str[2 * i + 1] + bit7_str[2 * (i + 1)]);
    tmp7 := (mst_7 shr (7 - (i mod 7)));
    mst_7 := mst_7 shl ((i mod 7) + 1);
    mst_7 := mst_7 shr 1;
    mst_8 := mst_7 or nmst_7;
    nmst_7 := tmp7;
    mst := mst + inttohex(mst_8, 2);
  end;
  for i := 1 to length(mst) div 2 do
    result := result + chr(strtoint('$' + mst[2 * i - 1] + mst[2 * i]));
end;

function Ucs2ToGBK(const InValue:string):string;
var
  I:Integer;
begin
  Result := '';
  for I := 1 to length(InValue) div 2 - 1 do
    Result := Result + WideChar(StrToInt('$' + IntToHex(Ord(InValue[2 * I - 1]),
      2)
      + IntToHex(Ord(InValue[2 * I]), 2)));
end;

end.