sm_msgdll.~pas

SM_Msg.rar 手机短信发送程序

unit SM_MsgDLL;

interface                              

uses  Messages, SysUtils, Windows, Forms, Classes, Math, ActiveX, Graphics, Registry;

type
  PUserInfo = ^TUserInfo;
  TUserInfo = Record
    FClasse_ID:integer;
    FCurPoint:integer;
    FCurIndex:integer;
    FClasse,
    FName,
    FPhoneNum1,
    FPhoneNum2,
    FFax,
    FHomePhone,
    FMobilePhone,
    FEmail,
    FUnit,
    FOfficeAdd,
    FCommAdd,
    FPost,
    FRetic,
    FQQNum,
    FBZ:String;
end;

type
 PClassInfo = ^TClassInfo;
 TClassInfo = Record
 FClass,FName:string;
end;

const
 CMGF_Falg    = $0001;
 CNIM_Falg    = $0002;
 Send_Falg    = $0003;
 SendMsg_Falg = $0004;
 CMGR_Falg    = $0005;
 CR           =#13#14;
 scWinClassName='短信精灵';
 CM_RESTORE = WM_USER + $1000;

var
  SendLine           :TStringList;
  back_msg_falg      :TStringList;
  PhoneNote_List     :TStringList;
  MobilePhone_List   :TStringList;
  PhoneBook          :TStringList;
  UserPhoneNote_Store:TList;
  UserClassInfo_Store:TList;
  Settings           :string;
  Head               :string;
  ReceiveStr         :string;
  SMPhone            :string;
  ZCSJ               :string;
  SM_StorF           :string; 
  SM_Center          :string;
  SM_Ray             :string;
  Reg_Phone          :string;  
  stat_msg           :string='连接...';
  ReceiveInfo        :Boolean;
  PortComm           :integer;
  Value              :integer;
  CurWork            :integer;
  Reserve            :integer;
  ShortMess_Mode     :integer;
  MsgCount           :integer=0;
  SIM_MsgCount       :integer=0;
//=============================================================================//
function AddChar(const Source:LongWord;Len:byte):string;stdcall;external 'SMConvDll.dll';
function ReadCInt(var Source:string;Size:byte;var CInt:LongWord):integer;stdcall;external 'SMConvDll.dll';
function ReadCStr(var Source:string):string;stdcall;external 'SMConvDll.dll';
function CheckUserRequest(Msg:string):boolean;stdcall;external 'SMConvDll.dll';
function UnicodeToStr(Source:string ):string;stdcall;external 'SMConvDll.dll';
function StrToUnicode(Source:string):string;stdcall;external 'SMConvDll.dll';
function BinToInt(Source:string):string;stdcall;external 'SMConvDll.dll';
function HexToBinEx(Source:string):string;stdcall;external 'SMConvDll.dll';
function IntToBin(Source:string):string;stdcall;external 'SMConvDll.dll';
function BinToHex(Source:string):string;stdcall;external 'SMConvDll.dll';
function HexStrToStr(Source:string):string;stdcall;external 'SMConvDll.dll';
function CheckNum(Str:string;Len:integer;CheckType:byte):Boolean;stdcall;external 'SMConvDll.dll';
//=============================================================================//
procedure CommSendMsg;      //发送信息
procedure CommRefresh;      //刷新端口
procedure CommCMGR;         //读取GSM SIM卡中的信息
procedure CommCMGD;         //删除GSM SIM卡中的信息
procedure CommCMGF;         //设置数据格式 0 PDU 1 TEXT
procedure CommCPBR;         //读取SIM卡中的电话号码

function CheckPhone(Len:Integer;CheckValue:string):Boolean;
function SplitString(const source,ch:string):Tstringlist;
function CurLogMsg(Falg:integer;Msg:string):string;
function WriteSM(Source:string):string;
function ReadSM(Source:string):string;
function EnglishSMConv(source:string):string;
procedure WriteDy(Context:TStringList);
procedure ErrorMsg(Falg:integer;ErrMsg:PChar);
procedure WriteSysReg;
procedure ReadSysReg;
procedure Delay(MSec: Word);

implementation

uses SM_MsgP;

procedure CommRefresh;
begin
try
 with frmSM_Msg.MSComm do
 begin
  if PortOpen then
   begin
    PortOpen:=False;
    DTREnable:=False;
    RTSEnable:=False;
   end;
  if not PortOpen then
   begin
    PortOpen:=True;
    DTREnable:=True;
    RTSEnable:=True;
    InputLen:=0;
    InBufferCount:=0;
    OutBufferCount:=0;
    Output:='AT+CMGF=0'+Char(13);
   end;
 end;
 CurLogMsg(0,'端口刷新成功!');
 stat_msg:='状态:端口刷新成功!';
 CurWork:=CMGF_Falg;
 frmSM_Msg.TmrBackMes.Enabled:=True;
 frmSM_Msg.bit_Send.Enabled:=False;
except
 on exception do
  raise exception.Create('端口COM'+IntToStr(PortComm)+'打开失败!');
end;
end;

procedure CommCPBR;
begin
try
if frmSM_Msg.MSComm.PortOpen  then
 begin
  stat_msg:='状态:正在读取SIM卡...';
  CurLogMsg(0,'正在读取SIM卡,请等待...');
  frmSM_Msg.MSComm.Output:='AT+CPBR=1,200'+Char(13);
  frmSM_Msg.TmrReceive.Enabled:=True;
 end;
except
 on exception do
  raise exception.Create(IntToStr(PortComm)+'端口发生错误!');
 end;
end;

procedure CommCMGF;
begin
try
with frmSM_Msg.MsComm do
begin
 if frmSM_Msg.MSComm.PortOpen then
  frmSM_Msg.MSComm.PortOpen:=False;
  CommPort:=PortComm;
  Settings:=Settings;
 // 打开串口
 if not frmSM_Msg.MSComm.PortOpen
  then frmSM_Msg.MSComm.PortOpen:=True;
  RThreshold:=1;
  DTREnable:=True;
  RTSEnable:=True;
  InputLen:=0;
  InBufferCount:=0;
  OutBufferCount:=0;
  Output:='AT+CMGF=0'+Char(13);
  Output:='AT+CNMI=0,2,2,0,0'+Char(13);
  CurWork:=CMGF_Falg;
  frmSM_Msg.TmrBackMes.Enabled:=True;
end;
except
 on exception do
  Raise exception.Create('打开COM'+IntToStr(PortComm)+'端口失败,请检查'+CR+'计算机端口!');
 end;
end;

procedure CommSendMsg;
var
 str:string;
 Len:integer;
begin
try
if frmSM_Msg.MSComm.PortOpen  then
 begin
  stat_msg:='状态:正在发送信息...';
  CurLogMsg(0,'正在发送信息,请等待...');
  Str:=SendLine.Strings[0];
  Len:=Length(SendLine.Strings[0]) div 2;
  frmSM_Msg.MSComm.Output:='AT+CMGS='+IntToStr((Length(MobilePhone_List.Strings[0]) div 2)+Len)+Char(13);
  frmSM_Msg.MSComm.OutPut:=MobilePhone_List.Strings[0]+IntToHex(Length(Str) div 2,2)+Str+Char(26);
  CurWork:=Send_Falg;
  frmSM_Msg.TmrBackMes.Enabled:=True;
  frmSM_Msg.TmrSend.Enabled:=False;
 end;
except
 on exception do
  raise exception.Create(IntToStr(PortComm)+'端口发生错误!');
 end;
end;

procedure CommCMGR;
begin
try
if frmSM_Msg.MSComm.PortOpen  then
 begin
  frmSM_Msg.MSComm.Output:='AT+CMGR='+IntToStr(SIM_MsgCount)+Char(13);
  CurWork:=CMGR_Falg;
  frmSM_Msg.TmrBackMes.Enabled:=True;
 end else
  CommCMGF;
except
 on exception do
  raise exception.Create(IntToStr(PortComm)+'端口发生错误!');
 end;
end;

procedure CommCMGD;
begin
try
if frmSM_Msg.MSComm.PortOpen  then
  frmSM_Msg.MSComm.Output:='AT+CMGD='+IntToStr(SIM_MsgCount)+Char(13)
 else
  CommCMGF;
except
 on exception do
  raise exception.Create(IntToStr(PortComm)+'端口发生错误!');
 end;
end;

function CurLogMsg(Falg:integer;Msg:string):string;
begin
Case Falg of
 0: begin
 if frmSM_Msg.mem_InfoReceive.Lines.Count<=100 then
  frmSM_Msg.mem_InfoReceive.Lines.Add(Msg) else
  begin
   frmSM_Msg.mem_InfoReceive.Lines.Add(Msg);
   frmSM_Msg.mem_InfoReceive.Lines.Delete(0);
  end;
  frmSM_Msg.mem_InfoReceive.Lines.Add('');
  end;
 1: begin
 if frmSM_Msg.mem_infoSend.Lines.Count<=100 then
  frmSM_Msg.mem_infoSend.Lines.Add(Msg) else
  begin
   frmSM_Msg.mem_InfoSend.Lines.Add(Msg);
   frmSM_Msg.mem_InfoSend.Lines.Delete(0);
  end;
  frmSM_Msg.mem_infoSend.Lines.Add('');
  end;

 9: begin
  frmSM_Msg.mem_InfoReceive.Clear;
  frmSM_Msg.mem_InfoReceive.Lines.Add(Msg);
  end;
 end;
end;

procedure ErrorMsg(Falg:Integer;ErrMsg:PChar);
begin
 Case Falg of
   0: Raise Exception.Create(ErrMsg);
   1:MessageBox(Application.handle,ErrMsg,PChar('注意'),MB_ICONINFORMATION);
   2:MessageBox(Application.handle,ErrMsg,PChar('错误'),MB_ICONSTOP);
   3:MessageBox(Application.handle,ErrMsg,PChar('错误'),MB_OK);
 end;
end;

function SplitString(const source,ch:string):tstringlist;
var
temp:string;
i:integer;
begin
result:=tstringlist.Create;
temp:=source;
i:=pos(ch,source);
while i<>0 do
begin
  result.Add(copy(temp,0,i-1));
  delete(temp,1,i);
  i:=pos(ch,temp);
end;
result.Add(temp);
end;

function CheckPhone(Len:Integer;CheckValue:string):Boolean;
var
 i:integer;
begin
Result:=False;
 for i:=1 to Length(CheckValue) do
  if not (CheckValue[i] in ['0'..'9']) then exit;
  if Length(CheckValue)<>Len then exit;
  if Copy(CheckValue,1,2)<>'13' then exit;
  Result:=True;
end;

function WriteSM(Source:string):string;
var
 i:integer;
 Ch:Char;
begin
 Result:='';
 if length(Source) mod 2=1
 then Source:=Source+'F';
 for i:=1 to length(Source) div 2 do
  begin
   Ch:=Source[i*2-1];
   Source[i*2-1]:=Source[i*2];
   Source[i*2]:=Ch;
  end;
  for i:=1 to 12-Length(Source) do
   Source:=Source+'F';
   Result:=Source;
end;

function ReadSM(Source:string):string;
var
 i:integer;
 Ch:Char;
begin
  Result:='';
  for i:=1 to Length(Source) div 2 do
    begin
      Ch:=Source[i*2-1];
      Source[i*2-1]:=Source[i*2];
      Source[i*2]:=Ch;
    end;
    while Source[Length(Source)]='F' do
     Source:=Copy(Source,1,Length(Source)-1);
     Result:=Source;
end;

{ 英文转换成ASCII码 }
function EnglishSMConv(Source:string):string;
var
 len,i,j:integer;
 fillstr,bins:string;
 binlist,HexAnsi:TstringList;
begin
fillstr:='00000000';
binlist:=TstringList.Create;
HexAnsi:=TstringList.Create;
len:=length(source) div 2;
j:=1;
Result:='';
for i:=0 to len-1 do
begin
bins:=HexToBinEx(Copy(source,j,2));
if length(bins)<8 then
bins:=copy(fillstr,1,8-length(bins))+bins;
binlist.Add(bins);
inc(j,2);
end;
j:=0;
for i:=0 to binlist.Count-1 do
begin
if j>0 then
bins:=Copy(binlist.Strings[i]+Copy(binlist.Strings[i-1],1,i),j+2,7)
else
bins:=Copy(binlist.Strings[i],j+2,7);
if (j=0)and(i>0) then
HexAnsi.Add(Copy(fillstr,1,2)+IntToHex(StrToInt(BinToInt(Copy(binlist.Strings[i-1],1,7))),2));
HexAnsi.Add(Copy(fillstr,1,2)+IntToHex(StrToInt(BinToInt(bins)),2));
inc(j);
if (j mod 7)=0 then j:=0;
end;
for i:=0 to HexAnsi.Count-1 do
  Result:=Result+HexAnsi.Strings[i];
binlist.Free;
HexAnsi.Free;
end;

procedure WriteDy(Context:TStringList);
var
 f:TextFile;
 s:string;
 i:integer;
begin
s:=ExtractFilePath(Application.ExeName)+'SM_Dy.Txt';
try
AssignFile(f,s);
// if FileExists(s) then Append(f)
ReWrite(f);
//  else ReWrite(f);
 for i:=0 to Context.Count-1 do
  Writeln(f,Context.Strings[i]);
 finally
 CloseFile(f);
end;
end;

procedure WriteSysReg;
var
 WriteRegIni:TRegistry;
begin
WriteRegIni:=TRegistry.Create;
try
with WriteRegIni do
 if OpenKey('SM\Value', True) then
   begin
    if not ValueExists('PortComm') then
       WriteInteger('PortComm',1);
    if not ValueExists('Settings') then
       WriteString('Settings','9600,N,8,1');
    if not ValueExists('Reserve') then
       WriteInteger('Reserve',1);
    if not ValueExists('ShortMess_Mode') then
       WriteInteger('ShortMess_Mode',1);
    if not ValueExists('SM_StorF') then
       WriteString('SM_StorF','1');
    if not ValueExists('Head') then
       WriteString('Head','0001000D9168');
    if not ValueExists('SM_CenterNum') then
       WriteString('SM_CenterNum','[phone]');
    if not ValueExists('SM_Ray') then
       WriteString('SM_Ray','1');
       WriteRegIni.CloseKey;
   end;
 finally
   WriteRegIni.Free;
end;
end;

procedure ReadSysReg;
var
 ReadRegIni:TRegistry;
begin
ReadRegIni:=TRegistry.Create;
try
 with ReadRegIni do
  if OpenKey('SM\Value',False) then
   begin
    PortComm :=ReadInteger('PortComm');
    Settings :=ReadString('Settings');
    Reserve  :=ReadInteger('Reserve');
    ShortMess_Mode:=ReadInteger('ShortMess_Mode');
    Head     :=ReadString('Head');
    SM_StorF :=ReadString('SM_StorF'); 
    SM_Center:=ReadString('SM_Center');
    SM_Ray   :=ReadString('SM_Ray');
    CloseKey;
   end;
 finally
   ReadRegIni.Free;
end;
end;

procedure Delay(MSec: Word);
var
  St,Ft:LongWord;
begin
  St:=GetTickCount;
  repeat
    Ft:=GetTickCount;
    Application.ProcessMessages;
  until Abs(Ft-St)>MSec;
end;

end.