comfun.~pas

delphi 7.0 开发的cdma手机发短信程序

unit COMFUN;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,Dialogs, StdCtrls,Forms,ComCtrls;

type
  TCommThread = class;
  Tcomfun = Class(TObject)
  private
    Receive: Boolean; //开关变量，代表是否接收
    FCommThread:TCommThread;//串口处理线程
  protected
//    procedure Execute; override;
   procedure SortOver(Sender:TObject);
  public
    Post_Event: THandle;//创建事件同步对象的句柄
    hSend:THandle;  //发送串口的句柄
    //Commcount:String;
//    constructor Create(CreateSuspended: Boolean;var SortArray: array of Integer);
    function Opencom(CommName:String):boolean;
    function wirtcom(CommStr:String):boolean;
    function closecom():boolean;
  published
  end;
//==发送串口数据的线程===============================================

TCommThread = class(TThread)
    //写入函数，阻塞模式，直到写入完成，返回写入字符个数
    //function WriteComm(pBuf:PChar;nLen:integer):integer;
private
    FidComDev:Cardinal;
protected
    procedure Execute; override; //主执行过程
public
    function wirtSort(CommName:String):Integer;

    constructor Create(idComDev:Cardinal;Commcount:String);//

  end;

TRecvThread = Class(TThread)
  public
    hRecv : THandle;//接收串口的句柄
    Read_os:Toverlapped;//重叠结构的变量
    Receive: Boolean; //开关变量，代表是否接收

    constructor Create(idComDev:Cardinal;Commcount:String);//
private
    //数据接收消息处理函数
    procedure WMCOMMNOTIFY(var Message: TMessage); message WM_COMMNOTIFY;
protected
    procedure Execute;override;
end;

var
wirtcomint:Integer;
CommTStr:String;
fWirtVal:boolean;
implementation
uses setcom;
//-------------读线程TRecvThread-------------------------------------------------------------------
//接收串口数据的线程执行体
constructor TCommThread.Create(idComDev:Cardinal;Commcount:String);
begin
  inherited Create(True);    //以立即执行方式创建线程
  //FidComDev := idComDev;
//CommTStr:=Commcount;
end;

procedure TRecvThread.Execute ;
var
  dwEvtMask, dwTranser: Dword;
  Ok: Boolean;
  Os: Toverlapped;
begin
  Receive := True;
  FillChar(Os, SizeOf(Os), 0);
  // 创建重叠读事件对象
  Os.hEvent := CreateEvent(nil, True, False, nil);
  if Os.hEvent = null then
  begin
    MessageBox(0, 'Os.Event Create Error !', 'Notice', MB_OK);
    Exit;
  end;
  if (not SetCommMask(hRecv, EV_RXCHAR)) then
  begin
    MessageBox(0, 'SetCommMask Error !', 'Notice', MB_OK);
    Exit;
  end;
  while (Receive) do
  begin
    dwEvtMask := 0;
    // 等待通讯事件发生
    if not WaitCommEvent(hRecv, dwEvtMask, @Os) then
    begin
      if ERROR_IO_PENDING = GetLastError then
        GetOverLappedResult(hRecv, Os, dwTranser, True)
    end;
    if ((dwEvtMask and EV_RXCHAR) = EV_RXCHAR) then
    begin
    // 等待允许传递WM_COMMNOTIFY通讯消息
      WaitForSingleObject(Post_event, INFINITE);
    // 处理WM_COMMNOTIFY消息时不再发送WM_COMMNOTIFY消息
      ResetEvent(Post_Event);
    // 传递WM_COMMNOTIFY通讯消息
      Ok := PostMessage(frmMain.Handle, WM_COMMNOTIFY, hRecv, 0);
      if (not Ok) then
      begin
        MessageBox(0, 'PostMessage Error !', 'Notice', MB_OK);
        Exit;
      end;
    end;
  end;
  CloseHandle(Os.hEvent); // 关闭重叠读事件对象
end;


// 数据接收消息处理函数
procedure TfrmMain.WMCOMMNOTIFY(var Message: TMessage);
var
  CommState: ComStat;
  dwNumberOfBytesRead: Dword;
  ErrorFlag: Dword;
  InputBuffer: array[0..1024] of Char;
  recvString : string;
begin
  if not ClearCommError(hRecv, ErrorFlag, @CommState) then
  begin
    MessageBox(0, 'ClearCommError !', 'Notice', MB_OK);
    PurgeComm(hRecv, Purge_Rxabort or Purge_Rxclear);
    Exit;
  end;
  if (CommState.cbInQue > 0) then
  begin
    fillchar(InputBuffer, CommState.cbInQue, #0);
      // 接收通讯数据
    if (not ReadFile(hRecv, InputBuffer, CommState.cbInQue,
      dwNumberOfBytesRead, @Read_os)) then
    begin
      ErrorFlag := GetLastError();
      if (ErrorFlag <> 0) and (ErrorFlag <> ERROR_IO_PENDING) then
      begin
        Receive := False;
        raise Exception.Create('读串口数据出错!');
      end
      else
      begin
        WaitForSingleObject(hRecv, INFINITE); // 等待操作完成
        GetOverlappedResult(hRecv, Read_os,
          dwNumberOfBytesRead, False);
      end;
    end;
    if dwNumberOfBytesRead > 0 then
    begin
      Read_Os.Offset := Read_Os.Offset + dwNumberOfBytesRead;
      // 处理接收的数据
      InputBuffer[dwNumberOfBytesRead]:=#0;
      mmoRecv.Lines.Add('接收到：'+intToStr(dwNumberOfBytesRead)+'个字节的数据');
      mmoRecv.Lines.Add(strPas(inputBuffer));
    end;
  end;
 // 允许发送下一个WM_COMMNOTIFY消息
  SetEvent(Post_Event);
end;



//-------------写线程TCommThread-------------------------------------------------------------------
constructor TCommThread.Create(idComDev:Cardinal;Commcount:String);
begin
  inherited Create(True);    //以立即执行方式创建线程
  FidComDev := idComDev;
  CommTStr:=Commcount;
end;

procedure TCommThread.Execute;

begin
  FreeOnTerminate := false;  //当线程执行完，终止线程
  wirtcomint:=wirtSort(CommTStr);
  
  //wirtSort(CommTStr);
end;

function TCommThread.wirtSort(CommName:String):Integer;
var
  dwNumberOfBytesWritten, dwNumberOfBytesToWrite,
  ErrorFlag, dwWhereToStartWriting: DWORD;
  pDataToWrite: PChar;
  RXFinish:Bool;
   //typedef struct _OVERLAPPED {
  //  ULONG_PTR  Internal;
  //  ULONG_PTR  InternalHigh;
  //  DWORD  Offset;
  //  DWORD  OffsetHigh;
  //  HANDLE hEvent;
  //  } OVERLAPPED;  包含了在异步输入输出种的信息
 //载delphi中就是TOVERLAPED
  write_os: Toverlapped;
begin
dwWhereToStartWriting := 0;
  dwNumberOfBytesWritten := 0;
  //设置将要向串口里写的数据长度
  dwNumberOfBytesToWrite := Length(CommName);
  //RXFinish:=false;
  if (dwNumberOfBytesToWrite = 0) then
  begin
    result :=0;
    exit;
  end;
    //将edtcomm里的文本传到pDataToWrite缓冲区
    pDataToWrite := Pchar(CommName);

    //把指定变量X在内存段中所占的低Count个字节赋为相同的值Value，
    //其中Value是填充的值，只能是Byte、Char或Boolean等单字节类型的值。
    //在Free Pascal中稍加扩展为FillChar(var X; Count: Longint; Value),
    //功能没变。
    FillChar(Write_Os, SizeOf(write_os), 'a');
    // 为重叠写创建事件对象
    Write_Os.hEvent := CreateEvent(nil, True, False, nil);
    //设置直到最后一个字符被发送
    //SetCommMask(hSend, EV_TXEMPTY);
    repeat
       // 发送通讯数据
    if not WriteFile(FidComDev, pDataToWrite[dwWhereToStartWriting],
        dwNumberOfBytesToWrite, dwNumberOfBytesWritten,
        @write_os) then
      begin
        ErrorFlag := GetLastError;
        //form2.mmoSend.Lines.Add('ErrorFlag：'+intToStr(dwNumberOfBytesToWrite)+'个字节的数据');
        if ErrorFlag <> 0 then
        begin
          if ErrorFlag = ERROR_IO_PENDING then
          begin
           WaitForSingleObject(Write_Os.hEvent, INFINITE);
            //等待设置好的事件发生,非零表示成功，零表示失败
            //如bWait为FALSE，而且异步操作仍在执行，则函数回返回零，
            //而GetLastError会设置成ERROR_IO_INCOMPLETE
            //函数GetOverLappedResult对串行设备或用DeviceIoControl函数打开的对象正确操作。
            //GetOverlappedResult函数来得到异步函数的执行情况
            //如果函数调用返回FALSE则可以用GetLastError来得到错误，
            //如果返回成功则可以通过lpNumberOfBytesTransferred参数来确定
            //当前有多少数据已经被读或写。
            //lpOverlapped参数必须与调用ReadFile或WriteFile时
            //使用同一个数据区。
            //最后一个参数bWait表明是否等待异步操作结束时才返回，
            //如果设置为TRUE就可以等待文件读写完成时返回，
            //否则就会马上返回，
            //利用这个特点可以利用它来等待异步文件操作的结束（
            //就如同等待事件变为有信号状态一样起到相同的作用）
            //重叠模型
            //用于因为读写操作未能完成返回ERROR_IO_PENDING的时候
            //得到失败的详细的信息
            //GetOverlappedResult API 在发出异步 I/O 请求后,
            //您可以使用 GetOverlappedResult API 来轮询请求的状态,
            //或者等待请求的完成。当请求完成时,GetOverlappedResult
            //将返回请求过程所传输的字节数
            GetOverlappedResult(hSend, Write_os,
              dwNumberOfBytesWritten, False);
          end
          else
          begin
           result :=0;
           exit;
          end;
        end;
      end;
      //减去已发生的数据长度
      Dec(dwNumberOfBytesToWrite, dwNumberOfBytesWritten);
      //记录已发送的数据长度
      Inc(dwWhereToStartWriting, dwNumberOfBytesWritten);
    //直到全部发送完
    until (dwNumberOfBytesToWrite <= 0);
    result :=dwWhereToStartWriting;
end;
//------------TCommThread类结束------------------------------------------------------------------------
//-----------Tcomfun类-------------------------------------------------------------------------
function Tcomfun.wirtcom(CommStr:String):boolean;
var
  fRetVal:boolean;
 begin
//result := false;
FCommThread :=TCommThread.Create(hSend,CommStr);
//FCommThread.OnTerminate
 FCommThread.OnTerminate:=SortOver;
  FCommThread.Resume;

FCommThread.WaitFor;
FCommThread.free;
{  if wirtcomint<>0 then
begin
 //form2.mmoSend.Lines.Add('已发送：'+intToStr(wirtcomint)+'个字节的数据');
 fWirtVal :=true;
 end
else
begin
fWirtVal := false;
//form2.mmoSend.Lines.Add('发送数据失败11');
//Application.MessageBox('发送数据失败','',MB_OK );
//EXIT;
end;}
 result :=fWirtVal;
end;

procedure Tcomfun.SortOver(Sender:TObject);
begin
if wirtcomint<>0 then
begin
//FCommThread.free;
 //form2.mmoSend.Lines.Add('已发送：'+intToStr(wirtcomint)+'个字节的数据');
 fWirtVal :=true;
 end
else
begin
fWirtVal := false;
//form2.mmoSend.Lines.Add('发送数据失败11');
//Application.MessageBox('发送数据失败','',MB_OK );
//EXIT;
end;
//result := wirtcomint;
 end;

function Tcomfun.closecom():boolean;
begin
CloseHandle(hSend);
end;
function Tcomfun.Opencom(CommName:String):boolean;
var
  dcb: TDCB;
  Error: Boolean;
begin
  result := false;
  //CommName := form2.ComboBox1.Text;
  // 打开发送串口
  hSend := CreateFile(PChar(CommName), GENERIC_READ or GENERIC_WRITE, 0, 0,
		OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
 //   hWecv:= hWend;
  if (hSend = INVALID_HANDLE_VALUE) then exit;
   // 设置输入和输出缓冲区大小
  SetupComm(hSend, 1024, 1024);//对指定设备初始化相关参数
  //设置串口的波特率、字符位数、奇偶校验、停止位
  GetCommState(hSend, dcb);//用指定通信设备的当前控制设置真充设备控制块（DCB)
  dcb.BaudRate := strToInt(form2.ComboBox2.Text);//波特率
  dcb.ByteSize := 8;//字符位数
  dcb.StopBits := 0 ;//0,1,2分别为１，1.5，２
  dcb.Parity := 0;//奇偶校验位
  Error := SetCommState(hSend,dcb);//重新初始化所有硬件和控制设置
  result :=Error;
  {if (not Error) then
    raise Exception.Create('设置'+ComboBox1.text+'错误');}
  end;
end.