www.pudn.com > java_delphi.rar > Unit2.pas

unit Unit2; 
 
interface 
 uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, ExtCtrls, StdCtrls, OoMisc, AdPort, ComCtrls, BinHexTools; 
 
 procedure waitcommEmpty(x: integer); 
 procedure ComPortInit(ComNumbe,Baud:string); 
 procedure ComPortClose(); 
 procedure sendsms(zhujiao,beijiao,duanxintxt: string); 
 procedure ComPortDestory(); 
  var 
   ComPort1: TApdComPort; 
 
 
implementation 
 
 procedure ComPortDestory(); 
     var  
 Temp: TObject; 
 begin 
 
   if ComPort1<>nil then 
    begin 
      try 
     Temp := TObject(ComPort1); 
     Pointer(ComPort1) := nil; 
     Temp.Free 
    except 
    showmessage('关闭异常'); 
   end; 
   end; 
 end; 
 
procedure ComPortInit(ComNumbe,Baud:string); 
var 
  s, s2: string; 
  x, i: integer; 
begin 
  try 
   ComPort1:=TApdComPort.Create(nil); 
   ComPort1.Open := false; 
   sleep(50); 
   ComPort1.ComNumber :=strtoint(ComNumbe); 
   ComPort1.Baud := strtoint(Baud); 
   ComPort1.Parity := pNone; 
   ComPort1.DataBits :=8; 
   ComPort1.StopBits :=1; 
   ComPort1.Open := true; 
   if ComPort1.Open then 
    begin 
      begin 
        x := length(s); 
        for i := 0 to (x div 16) do 
        begin 
          s2 := copy(s, i * 16 + 1, 16); 
          ComPort1.PutString(s2); 
          waitcommEmpty(16); 
        end; 
      end; 
    end; 
  except 
    showmessage('串口不存在或被占用。'); 
  end; 
end; 
 
function Decode_cn(MSG: string): WideString; 
var i, j, len: Integer; 
  twideChar: integer; 
begin 
  try 
    i := Length(MSG) mod 4; 
    if i <> 0 then 
    begin 
      for j := 1 to 4 - i do 
        MSG := MSG + '0'; 
    end; 
    Len := Length(MSG) div 4; 
    SetLength(Result, Len); 
    Result := ''; 
    for i := 1 to Len do 
    begin 
      tWideChar := StrToInt('$' + Copy(MSG, 1 + (i - 1) * 4, 4)); 
      Result := Result + WideChar(tWideChar); 
    end; 
  except 
    Result := ''; 
  end; 
end; 
 
function str_Gb2UniCode(text: string): string; 
var 
  i, j, len: Integer; 
  cur: Integer; 
  t: string; 
  ws: WideString; 
begin 
  Result := ''; 
  ws := text; 
  len := Length(ws); 
  i := 1; 
  j := 0; 
  while i <= len do 
  begin 
    cur := ord(ws[i]); 
    FmtStr(t, '%4.4X', [cur]); //BCD转换 
    Result := Result + t; 
    inc(i); 
    //移位计数达到7位的特别处理 
    j := (j + 1) mod 7; 
  end; 
end; 
 
function ConvertL2R(sMsg: string): string; 
var i: Integer; 
  cTmp: Char; 
  sRe: string; 
begin 
  sRe := Trim(sMsg); 
  i := Length(sRe); 
  if i = 0 then 
  begin 
    Result := ''; 
    Exit; 
  end; 
 
  if i mod 2 = 1 then 
    sRe := sRe + 'F'; 
 
  i := 1; 
  while i < Length(sRe) do 
  begin 
    cTmp := sRe[i]; 
    sRe[i] := sRe[i + 1]; 
    sRe[i + 1] := cTmp; 
    i := i + 2; 
  end; 
 
  Result := sRe; 
end; 
 
function TextToPdu(sCenter, sPhone, sMsg: string; var a: string; var b: string): boolean; 
var sAddr, sBody: string; 
  LCenter, LMsg, LBody: string; 
begin 
  sCenter := '91' + ConvertL2R(sCenter); 
  FmtStr(LCenter, '%2.2X', [Length(sCenter) div 2]); 
  sAddr := LCenter + sCenter; 
 
  sPhone := ConvertL2R(sPhone); 
  sMsg := str_Gb2UniCode(sMsg); 
  FmtStr(LMsg, '%2.2X', [Length(sMsg) div 2]); 
 
  sBody := '11000D9168' + sPhone + '000800' + LMsg + sMsg; 
  FmtStr(LBody, '%2.2D', [Length(sBody) div 2]); 
  a := 'AT+CMGS=' + LBody + #13; //要发送的长度 
  b := sAddr + sBody + #26 + #13; //要发送的pdu代码 
  Result := true; 
 
end; 
 
procedure waitcommEmpty(x: integer); 
begin 
  application.ProcessMessages; 
  while (ComPort1.OutSize -ComPort1.OutBuffUsed < x) do 
  begin 
    sleep(200); 
  end; 
  sleep(20); 
end; 
procedure ComPortClose(); 
begin 
   ComPort1.Open := false; 
   ComPort1.Free; 
end; 
 
 
procedure sendsms(zhujiao,beijiao,duanxintxt: string); 
var 
  a1, a2, s, s2: string; 
  x, i: integer; 
begin 
  TextToPdu(zhujiao, beijiao, duanxintxt, a1, a2); 
  s := a1; 
  if ComPort1.Open then 
  begin 
    x := length(s); 
    for i := 0 to (x div 16) do 
    begin 
      s2 := copy(s, i * 16 + 1, 16); 
      ComPort1.PutString(s2); 
      waitcommEmpty(16); 
    end; 
  end else 
  begin 
    showmessage('串口未打开。'); 
  end; 
  sleep(6000); 
  s := a2; 
  if ComPort1.Open then 
  begin 
    x := length(s); 
    for i := 0 to (x div 16) do 
    begin 
      s2 := copy(s, i * 16 + 1, 16); 
      ComPort1.PutString(s2); 
      waitcommEmpty(16); 
    end; 
  end else 
  begin 
    showmessage('串口未打开。'); 
  end; 
end; 
end.